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

Tabled execution (SLG WAM)

This library handled tabled execution of predicates using the characteristics if the SLG WAM. The required suspension is realised using delimited continuations implemented by reset/3 and shift/1. The table space and work lists are part of the SWI-Prolog core.

author
- Benoit Desouter, Jan Wielemaker and Fabrizio Riguzzi */
   83% Enable debugging using debug(tabling(Topic)) when compiled with
   84% -DO_DEBUG
   85goal_expansion(tdebug(Topic, Fmt, Args), Expansion) :-
   86    (   current_prolog_flag(prolog_debug, true)
   87    ->  Expansion = debug(tabling(Topic), Fmt, Args)
   88    ;   Expansion = true
   89    ).
   90goal_expansion(tdebug(Goal), Expansion) :-
   91    (   current_prolog_flag(prolog_debug, true)
   92    ->  Expansion = (   debugging(tabling(_))
   93                    ->  (   Goal
   94                        ->  true
   95                        ;   print_message(error, goal_failed(Goal))
   96                        )
   97                    ;   true
   98                    )
   99    ;   Expansion = true
  100    ).
  101
  102:- if(current_prolog_flag(prolog_debug, true)).  103wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
  104    !,
  105    '$tbl_worklist_data'(WorkList, worklist(_SCC,Trie,_,_,_)),
  106    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  107    unqualify_goal(Wrapper, user, Goal).
  108wl_goal(WorkList, Goal, Skeleton) :-
  109    '$tbl_worklist_data'(WorkList, worklist(_SCC,Trie,_,_,_)),
  110    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  111    unqualify_goal(Wrapper, user, Goal).
  112
  113trie_goal(ATrie, Goal, Skeleton) :-
  114    '$tbl_table_status'(ATrie, _Status, Wrapper, Skeleton),
  115    unqualify_goal(Wrapper, user, Goal).
  116
  117delay_goals(List, Goal) :-
  118    delay_goals(List, user, Goal).
  119
  120user_goal(Goal, UGoal) :-
  121    unqualify_goal(Goal, user, UGoal).
  122
  123:- 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.

  148table(M:PIList) :-
  149    setup_call_cleanup(
  150        '$set_source_module'(OldModule, M),
  151        expand_term((:- table(PIList)), Clauses),
  152        '$set_source_module'(OldModule)),
  153    dyn_tabling_list(Clauses, M).
  154
  155dyn_tabling_list([], _).
  156dyn_tabling_list([H|T], M) :-
  157    dyn_tabling(H, M),
  158    dyn_tabling_list(T, M).
  159
  160dyn_tabling(M:Clause, _) :-
  161    !,
  162    dyn_tabling(Clause, M).
  163dyn_tabling((:- multifile(PI)), M) :-
  164    !,
  165    multifile(M:PI),
  166    dynamic(M:PI).
  167dyn_tabling(:- initialization(Wrap, now), M) :-
  168    !,
  169    M:Wrap.
  170dyn_tabling('$tabled'(Head, TMode), M) :-
  171    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  172        (   OMode \== TMode
  173        ->  erase(Ref),
  174            fail
  175        ;   true
  176        )
  177    ->  true
  178    ;   assertz(M:'$tabled'(Head, TMode))
  179    ).
  180dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  181    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  182    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  183        ->  true
  184        ;   erase(Ref),
  185            assertz(M:'$table_mode'(Head, Variant, Moded))
  186        )
  187    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  188    ).
  189dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  190    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  191    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  192        ->  true
  193        ;   erase(Ref),
  194            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  195        )
  196    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  197    ).
 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.
  208untable(M:PIList) :-
  209    untable(PIList, M).
  210
  211untable(Var, _) :-
  212    var(Var),
  213    !,
  214    '$instantiation_error'(Var).
  215untable(M:Spec, _) :-
  216    !,
  217    '$must_be'(atom, M),
  218    untable(Spec, M).
  219untable((A,B), M) :-
  220    !,
  221    untable(A, M),
  222    untable(B, M).
  223untable(Name//Arity, M) :-
  224    atom(Name), integer(Arity), Arity >= 0,
  225    !,
  226    Arity1 is Arity+2,
  227    untable(Name/Arity1, M).
  228untable(Name/Arity, M) :-
  229    !,
  230    functor(Head, Name, Arity),
  231    (   predicate_property(M:Head, tabled(_))
  232    ->  abolish_table_subgoals(M:Head),
  233        dynamic(M:'$tabled'/2),
  234        dynamic(M:'$table_mode'/3),
  235        retractall(M:'$tabled'(Head, _TMode)),
  236        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  237        unwrap_predicate(M:Name/Arity, table),
  238        '$set_predicate_attribute'(M:Head, tabled, false)
  239    ;   true
  240    ).
  241untable(Head, M) :-
  242    callable(Head),
  243    !,
  244    functor(Head, Name, Arity),
  245    untable(Name/Arity, M).
  246untable(TableSpec, _) :-
  247    '$type_error'(table_desclaration, TableSpec).
 start_tabling(:Wrapper, :Implementation)
Execute Implementation using tabling. This predicate should not be called directly. The table/1 directive causes a predicate to be translated into a renamed implementation and a wrapper that involves this predicate.
Compatibility
- This interface may change or disappear without notice from future versions.
  260'$wrap_tabled'(Head, Options) :-
  261    get_dict(mode, Options, subsumptive),
  262    !,
  263    set_pattributes(Head, Options),
  264    '$wrap_predicate'(Head, table, Wrapped,
  265                      start_subsumptive_tabling(Head, Wrapped)).
  266'$wrap_tabled'(Head, Options) :-
  267    !,
  268    set_pattributes(Head, Options),
  269    '$wrap_predicate'(Head, table, Wrapped,
  270                      start_tabling(Head, Wrapped)).
  271
  272set_pattributes(Head, Options) :-
  273    '$set_predicate_attribute'(Head, tabled, true),
  274    (   get_dict(incremental, Options, true)
  275    ->  '$set_predicate_attribute'(Head, incremental, true)
  276    ;   true
  277    ),
  278    (   get_dict(dynamic, Options, true)
  279    ->  '$set_predicate_attribute'(Head, dynamic, true)
  280    ;   true
  281    ),
  282    (   get_dict(tshared, Options, true)
  283    ->  '$set_predicate_attribute'(Head, tshared, true)
  284    ;   true
  285    ).
  286
  287
  288start_tabling(Wrapper, Worker) :-
  289    '$tbl_variant_table'(Wrapper, Trie, Status, Skeleton),
  290    (   Status == complete
  291    ->  '$idg_add_edge'(Trie),
  292        trie_gen_compiled(Trie, Skeleton)
  293    ;   Status == fresh
  294    ->  '$tbl_create_subcomponent'(SCC, Trie),
  295        tdebug(user_goal(Wrapper, Goal)),
  296        tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  297        '$idg_add_edge'(OldCurrent, Trie),
  298        setup_call_catcher_cleanup(
  299            true,
  300            run_leader(Skeleton, Worker, Trie, SCC, LStatus),
  301            Catcher,
  302            finished_leader(Catcher, SCC, Wrapper)),
  303        tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  304        '$idg_set_current'(OldCurrent),
  305        done_leader(LStatus, SCC, Skeleton, Trie)
  306    ;   Status == invalid
  307    ->  reeval(Trie),
  308        '$idg_add_edge'(Trie),
  309        trie_gen_compiled(Trie, Skeleton)
  310    ;   % = run_follower, but never fresh and Status is a worklist
  311        shift(call_info(Skeleton, Status))
  312    ).
 start_subsumptive_tabling(:Wrapper, :Implementation)
  317start_subsumptive_tabling(Wrapper, Worker) :-
  318    (   '$tbl_existing_variant_table'(Wrapper, Trie, Status, Skeleton)
  319    ->  (   Status == complete
  320        ->  '$idg_add_edge'(Trie),
  321            '$tbl_answer_update_dl'(Trie, Skeleton)
  322        ;   Status == invalid
  323        ->  reeval(Trie),
  324            '$idg_add_edge'(Trie),
  325            '$tbl_answer_update_dl'(Trie, Skeleton)
  326        ;    shift(call_info(Skeleton, Status))
  327        )
  328    ;   more_general_table(Wrapper, ATrie),
  329        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  330    ->  '$idg_add_edge'(ATrie),
  331        '$tbl_answer_update_dl'(ATrie, Skeleton)
  332    ;   '$tbl_variant_table'(Wrapper, Trie, _0Status, Skeleton),
  333        tdebug(_0Status == fresh),
  334        '$tbl_create_subcomponent'(SCC, Trie),
  335        tdebug(user_goal(Wrapper, Goal)),
  336        tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  337        '$idg_add_edge'(OldCurrent, Trie),
  338        setup_call_catcher_cleanup(
  339            true,
  340            run_leader(Skeleton, Worker, Trie, SCC, LStatus),
  341            Catcher,
  342            finished_leader(Catcher, SCC, Wrapper)),
  343        '$idg_set_current'(OldCurrent),
  344        tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  345        done_leader(LStatus, SCC, Skeleton, Trie)
  346    ).
  347
  348
  349done_leader(complete, _SCC, Skeleton, Trie) :-
  350    !,
  351    trie_gen_compiled(Trie, Skeleton).
  352done_leader(final, SCC, Skeleton, Trie) :-
  353    !,
  354    '$tbl_free_component'(SCC),
  355    trie_gen_compiled(Trie, Skeleton).
  356done_leader(_,_,_,_).
  357
  358finished_leader(exit, _, _) :-
  359    !.
  360finished_leader(fail, _, _) :-
  361    !.
  362finished_leader(Catcher, SCC, Wrapper) :-
  363    '$tbl_table_discard_all'(SCC),
  364    (   Catcher = exception(_)
  365    ->  true
  366    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  367    ).
 run_leader(+Wrapper, +Worker, +Trie, +SCC, -Status) 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.

  382run_leader(Skeleton, Worker, Trie, SCC, Status) :-
  383    tdebug('$tbl_table_status'(Trie, _Status, Wrapper, Skeleton)),
  384    tdebug(user_goal(Wrapper, Goal)),
  385    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  386    activate(Skeleton, Worker, Trie, Worklist),
  387    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  388    completion(SCC),
  389    tdebug(schedule, '-> Completed component ~p for ~p', [SCC, Goal]),
  390    '$tbl_component_status'(SCC, Status),
  391    (   Status == merged
  392    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  393        '$tbl_wkl_make_follower'(Worklist),
  394        shift(call_info(Skeleton, Worklist))
  395    ;   true                                    % completed
  396    ).
  397
  398activate(Wrapper, Worker, Trie, WorkList) :-
  399    '$tbl_new_worklist'(WorkList, Trie),
  400    tdebug(activate, '~p: created wl=~p, trie=~p',
  401           [Wrapper, WorkList, Trie]),
  402    (   reset_delays,
  403        delim(Wrapper, Worker, WorkList, []),
  404        fail
  405    ;   true
  406    ).
 delim(+Wrapper, +Worker, +WorkList, +Delays)
Call/resume Worker for non-mode directed tabled predicates.
  412delim(Wrapper, Worker, WorkList, Delays) :-
  413    reset(Worker, SourceCall, Continuation),
  414    tdebug(wl_goal(WorkList, Goal, _)),
  415    (   Continuation == 0
  416    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  417        tdebug(delay_goals(AllDelays, Cond)),
  418        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  419               [Wrapper, Goal, Cond]),
  420        '$tbl_wkl_add_answer'(WorkList, Wrapper, Delays, Complete),
  421        Complete == !,
  422        !
  423    ;   SourceCall = call_info(SrcSkeleton, SourceWL),
  424        '$tbl_add_global_delays'(Delays, AllDelays),
  425        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  426        tdebug(wl_goal(WorkList, DstGoal, _)),
  427        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  428        '$tbl_wkl_add_suspension'(
  429            SourceWL,
  430            dependency(SrcSkeleton, Continuation, Wrapper, WorkList, AllDelays))
  431    ).
 start_tabling(:Wrapper, :Implementation, +Variant, +ModeArgs)
As start_tabling/2, but in addition separates the data stored in the answer trie in the Variant and ModeArgs.
  438'$moded_wrap_tabled'(Head, ModeTest, WrapperNoModes, ModeArgs) :-
  439    '$set_predicate_attribute'(Head, tabled, true),
  440    '$wrap_predicate'(Head, table, Wrapped,
  441                      (   ModeTest,
  442                          start_tabling(Head, Wrapped, WrapperNoModes, ModeArgs)
  443                      )).
  444
  445
  446start_tabling(Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  447    '$tbl_moded_variant_table'(WrapperNoModes, Trie, Status, _Skeleton),
  448    (   Status == complete
  449    ->  '$idg_add_edge'(Trie),
  450        trie_gen(Trie, WrapperNoModes, ModeArgs)
  451    ;   Status == fresh
  452    ->  '$tbl_create_subcomponent'(SubComponent, Trie),
  453        '$idg_add_edge'(OldCurrent, Trie),
  454        setup_call_catcher_cleanup(
  455            true,
  456            run_leader(Wrapper, WrapperNoModes, ModeArgs,
  457                       Worker, Trie, SubComponent, LStatus),
  458            Catcher,
  459            finished_leader(Catcher, SubComponent, Wrapper)),
  460        '$idg_set_current'(OldCurrent),
  461        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  462               [Wrapper, ModeArgs, LStatus]),
  463        moded_done_leader(LStatus, SubComponent, WrapperNoModes, ModeArgs, Trie)
  464    ;   Status == invalid
  465    ->  reeval(Trie),
  466        '$idg_add_edge'(Trie),
  467        trie_gen(Trie, WrapperNoModes, ModeArgs)
  468    ;   % = run_follower, but never fresh and Status is a worklist
  469        shift(call_info(Wrapper, Status))
  470    ).
  471
  472moded_done_leader(complete, _SCC, WrapperNoModes, ModeArgs, Trie) :-
  473    !,
  474    trie_gen(Trie, WrapperNoModes, ModeArgs).
  475moded_done_leader(final, SCC, WrapperNoModes, ModeArgs, Trie) :-
  476    !,
  477    '$tbl_free_component'(SCC),
  478    trie_gen(Trie, WrapperNoModes, ModeArgs).
  479moded_done_leader(_, _, _, _, _).
  480
  481
  482get_wrapper_no_mode_args(M:Wrapper, M:WrapperNoModes, ModeArgs) :-
  483    M:'$table_mode'(Wrapper, WrapperNoModes, ModeArgs).
  484
  485run_leader(Wrapper, WrapperNoModes, ModeArgs, Worker, Trie, SCC, Status) :-
  486    moded_activate(Wrapper, WrapperNoModes, ModeArgs, Worker, Trie, Worklist),
  487    completion(SCC),
  488    '$tbl_component_status'(SCC, Status),
  489    (   Status == merged
  490    ->  tdebug(scc, 'Turning leader ~p into follower', [Wrapper]),
  491        (   trie_gen(Trie, WrapperNoModes1, ModeArgs1),
  492            tdebug(scc, 'Adding old answer ~p+~p to worklist ~p',
  493                   [ WrapperNoModes1, ModeArgs1, Worklist]),
  494            '$tbl_wkl_mode_add_answer'(Worklist, WrapperNoModes1,
  495                                       ModeArgs1, Wrapper),
  496            fail
  497        ;   true
  498        ),
  499        shift(call_info(Wrapper, Worklist))
  500    ;   true                                    % completed
  501    ).
  502
  503
  504moded_activate(Wrapper, WrapperNoModes, _ModeArgs, Worker, Trie, WorkList) :-
  505    '$tbl_new_worklist'(WorkList, Trie),
  506    (   moded_delim(Wrapper, WrapperNoModes, Worker, WorkList, []), % FIXME: Delay list
  507        fail
  508    ;   true
  509    ).
 moded_delim(+Wrapper, +WrapperNoModes, +Worker, +WorkList, +Delays)
Call/resume Worker for mode directed tabled predicates.
  515moded_delim(Wrapper, WrapperNoModes, Worker, WorkList, Delays) :-
  516    reset(Worker, SourceCall, Continuation),
  517    moded_add_answer_or_suspend(Continuation, Wrapper, WrapperNoModes,
  518                                WorkList, SourceCall, Delays).
  519
  520moded_add_answer_or_suspend(0, Wrapper, WrapperNoModes, WorkList, _, _) :-
  521    !,
  522    get_wrapper_no_mode_args(Wrapper, _, ModeArgs),
  523    '$tbl_wkl_mode_add_answer'(WorkList, WrapperNoModes,
  524                               ModeArgs, Wrapper). % FIXME: Add Delays
  525moded_add_answer_or_suspend(Continuation, Wrapper, _WrapperNoModes, WorkList,
  526                      call_info(SrcWrapper, SourceWL),
  527                      Delays) :-
  528    '$tbl_wkl_add_suspension'(
  529        SourceWL,
  530        dependency(SrcWrapper, Continuation, Wrapper, WorkList, Delays)).
 update(+Wrapper, +A1, +A2, -A3) is semidet
Update the aggregated value for an answer. Wrapper is the tabled goal, A1 is the aggregated value so far, A2 is the new answer and A3 should be unified with the new aggregated value. The new aggregate is ignored if it is the same as the old one.
  540:- public
  541    update/4.  542
  543update(M:Wrapper, A1, A2, A3) :-
  544    M:'$table_update'(Wrapper, A1, A2, A3),
  545    A1 \=@= A3.
 completion(+Component)
Wakeup suspended goals until no new answers are generated. The second argument of completion/2 keeps the current heap delay list, called the D register in th XSB literature. It is modified from the C core (negative_worklist()) using (backtrackable) destructive assignment. The C core walks the environment to find completion/2 and from there the delay list.
  557completion(SCC) :-
  558    (   reset_delays,
  559        completion_(SCC),
  560        fail
  561    ;   true
  562    ).
  563
  564completion_(SCC) :-
  565    repeat,
  566    '$tbl_component_status'(SCC, Status),
  567    (   Status == active
  568    ->  (   '$tbl_pop_worklist'(SCC, WorkList)
  569        ->  tdebug(wl_goal(WorkList, Goal, _)),
  570            tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  571            completion_step(WorkList),
  572            fail
  573        ;   tdebug(schedule, 'Completed ~p', [scc(SCC)]),
  574            '$tbl_table_complete_all'(SCC)
  575        )
  576    ;   Status == merged
  577    ->  tdebug(schedule, 'Aborted completion of ~p', [scc(SCC)])
  578    ;   true
  579    ),
  580    !.
  581
  582completion_step(WorkList) :-
  583    (   '$tbl_trienode'(Reserved),
  584        '$tbl_wkl_work'(WorkList,
  585                        Answer, ModeArgs,
  586                        Goal, Continuation, Wrapper, TargetWorklist, Delays),
  587        '$idg_set_current_wl'(TargetWorklist),
  588        tdebug(wl_goal(WorkList, SourceGoal, _)),
  589        tdebug(wl_goal(TargetWorklist, TargetGoal, _Skeleton)),
  590        (   ModeArgs == Reserved
  591        ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  592            tdebug(delay_goals(AllDelays, Cond)),
  593            tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  594                   [TargetGoal, SourceGoal, Answer, Cond]),
  595            Goal = Answer,
  596            delim(Wrapper, Continuation, TargetWorklist, Delays)
  597        ;   get_wrapper_no_mode_args(Goal, Answer, ModeArgs),
  598            get_wrapper_no_mode_args(Wrapper, WrapperNoModes, _),
  599            moded_delim(Wrapper, WrapperNoModes, Continuation, TargetWorklist,
  600                        Delays)
  601        ),
  602        fail
  603    ;   true
  604    ).
  605
  606
  607		 /*******************************
  608		 *     STRATIFIED NEGATION	*
  609		 *******************************/
 tnot(:Goal)
Tabled negation.
  615tnot(Goal0) :-
  616    '$tbl_implementation'(Goal0, Goal),         % verifies Goal is tabled
  617    '$tbl_variant_table'(Goal, Trie, Status, Skeleton),
  618    \+ \+ '$idg_add_edge'(Trie),                % do not update current node
  619    (   '$tbl_answer_dl'(Trie, _, true)
  620    ->  fail
  621    ;   '$tbl_answer_dl'(Trie, _, _)
  622    ->  add_delay(Trie)
  623    ;   Status == complete
  624    ->  true
  625    ;   Status == fresh
  626    ->  tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  627        (   call(Goal),
  628            fail
  629        ;   '$tbl_variant_table'(Goal, Trie, NewStatus, NewSkeleton),
  630            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  631            (   '$tbl_answer_dl'(Trie, _, true)
  632            ->  fail
  633            ;   '$tbl_answer_dl'(Trie, _, _)
  634            ->  add_delay(Trie)
  635            ;   NewStatus == complete
  636            ->  true
  637            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  638            )
  639        )
  640    ;   negation_suspend(Goal, Skeleton, Status)
  641    ).
 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.

  652negation_suspend(Wrapper, Skeleton, Worklist) :-
  653    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  654    '$tbl_wkl_negative'(Worklist),
  655    shift(call_info(Skeleton, tnot(Worklist))),
  656    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  657    '$tbl_wkl_is_false'(Worklist).
  658
  659
  660		 /*******************************
  661		 *           DELAY LISTS	*
  662		 *******************************/
  663
  664add_delay(Delay) :-
  665    '$tbl_delay_list'(DL0),
  666    '$tbl_set_delay_list'([Delay|DL0]).
  667
  668reset_delays :-
  669    '$tbl_set_delay_list'([]).
 $wfs_call(:Goal, :Delays)
Call Goal and provide WFS delayed goals as a conjunction in Delays. This predicate is teh internal version of call_delays/2 from library(wfs).
  677'$wfs_call'(Goal, M:Delays) :-
  678    '$tbl_delay_list'(DL0),
  679    reset_delays,
  680    call(Goal),
  681    '$tbl_delay_list'(DL1),
  682    (   delay_goals(DL1, M, Delays)
  683    ->  true
  684    ;   Delays = undefined
  685    ),
  686    '$append'(DL0, DL1, DL),
  687    '$tbl_set_delay_list'(DL).
  688
  689delay_goals([], _, true) :-
  690    !.
  691delay_goals([AT+AN|T], M, Goal) :-
  692    !,
  693    (   integer(AN)
  694    ->  at_delay_goal(AT, M, G0, Answer),
  695        trie_term(AN, Answer)
  696    ;   '$tbl_table_status'(AT, _Status, G0, AN)
  697    ),
  698    GN = G0,
  699    (   T == []
  700    ->  Goal = GN
  701    ;   Goal = (GN,GT),
  702        delay_goals(T, M, GT)
  703    ).
  704delay_goals([AT|T], M, Goal) :-
  705    at_delay_goal(AT, M, G0, _Skeleton),
  706    GN = tnot(G0),
  707    (   T == []
  708    ->  Goal = GN
  709    ;   Goal = (GN,GT),
  710        delay_goals(T, M, GT)
  711    ).
  712
  713at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton) :-
  714    is_trie(Trie),
  715    !,
  716    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  717    unqualify_goal(Wrapper, M, Goal).
  718at_delay_goal(Trie, M, Goal, Skeleton) :-
  719    is_trie(Trie),
  720    !,
  721    '$tbl_table_status'(Trie, _Status, Wrapper, Skeleton),
  722    unqualify_goal(Wrapper, M, Goal).
  723
  724unqualify_goal(M:Goal, M, Goal0) :-
  725    !,
  726    Goal0 = Goal.
  727unqualify_goal(Goal, _, Goal).
  728
  729
  730                 /*******************************
  731                 *            CLEANUP           *
  732                 *******************************/
 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.
Errors
- permission_error(abolish, table, all) if tabling is in progress.
  743abolish_all_tables :-
  744    '$tbl_abolish_all_tables'.
 abolish_table_subgoals(:Subgoal) is det
Abolish all tables that unify with SubGoal.
  750abolish_table_subgoals(SubGoal0) :-
  751    '$tbl_implementation'(SubGoal0, M:SubGoal),
  752    '$tbl_variant_table'(VariantTrie),
  753    !,
  754    current_module(M),
  755    forall(trie_gen(VariantTrie, M:SubGoal, Trie),
  756           '$tbl_destroy_table'(Trie)).
  757abolish_table_subgoals(_).
 abolish_module_tables(+Module) is det
Abolish all tables for predicates associated with the given module.
  763abolish_module_tables(Module) :-
  764    '$must_be'(atom, Module),
  765    '$tbl_variant_table'(VariantTrie),
  766    current_module(Module),
  767    !,
  768    forall(trie_gen(VariantTrie, Module:_, Trie),
  769           '$tbl_destroy_table'(Trie)).
  770abolish_module_tables(_).
 abolish_nonincremental_tables is det
Abolish all tables that are not related to incremental predicates.
  776abolish_nonincremental_tables :-
  777    '$tbl_variant_table'(VariantTrie),
  778    (   trie_gen(VariantTrie, _, Trie),
  779        '$tbl_table_status'(Trie, Status, Goal, _),
  780        (   Status == complete
  781        ->  true
  782        ;   '$permission_error'(abolish, incomplete_table, Trie)
  783        ),
  784        \+ predicate_property(Goal, incremental),
  785        '$tbl_destroy_table'(Trie),
  786        fail
  787    ;   true
  788    ).
 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.
  797abolish_nonincremental_tables(Options) :-
  798    (   Options = on_incomplete(Action)
  799    ->  Action == skip
  800    ;   '$option'(on_incomplete(skip), Options)
  801    ),
  802    !,
  803    '$tbl_variant_table'(VariantTrie),
  804    (   trie_gen(VariantTrie, _, Trie),
  805        '$tbl_table_status'(Trie, complete, Goal, _),
  806        \+ predicate_property(Goal, incremental),
  807        '$tbl_destroy_table'(Trie),
  808        fail
  809    ;   true
  810    ).
  811abolish_nonincremental_tables(_) :-
  812    abolish_nonincremental_tables.
  813
  814
  815                 /*******************************
  816                 *        EXAMINE TABLES        *
  817                 *******************************/
 current_table(:Variant, -Trie) is nondet
True when Trie is the answer table for Variant.
  823current_table(M:Variant, Trie) :-
  824    '$tbl_variant_table'(VariantTrie),
  825    (   (var(Variant) ; var(M))
  826    ->  trie_gen(VariantTrie, M:Variant, Trie)
  827    ;   trie_lookup(VariantTrie, M:Variant, Trie)
  828    ).
  829
  830
  831                 /*******************************
  832                 *      WRAPPER GENERATION      *
  833                 *******************************/
  834
  835:- multifile
  836    system:term_expansion/2,
  837    tabled/2.  838:- dynamic
  839    system:term_expansion/2.  840
  841wrappers(Spec, M) -->
  842    wrappers(Spec, M, #{}).
  843
  844wrappers(Var, _, _) -->
  845    { var(Var),
  846      !,
  847      '$instantiation_error'(Var)
  848    }.
  849wrappers(M:Spec, _, Opts) -->
  850    !,
  851    { '$must_be'(atom, M) },
  852    wrappers(Spec, M, Opts).
  853wrappers(Spec as Options, M, Opts0) -->
  854    !,
  855    { table_options(Options, Opts0, Opts) },
  856    wrappers(Spec, M, Opts).
  857wrappers((A,B), M, Opts) -->
  858    !,
  859    wrappers(A, M, Opts),
  860    wrappers(B, M, Opts).
  861wrappers(Name//Arity, M, Opts) -->
  862    { atom(Name), integer(Arity), Arity >= 0,
  863      !,
  864      Arity1 is Arity+2
  865    },
  866    wrappers(Name/Arity1, M, Opts).
  867wrappers(Name/Arity, Module, Opts) -->
  868    { '$option'(mode(TMode), Opts, variant),
  869      atom(Name), integer(Arity), Arity >= 0,
  870      !,
  871      functor(Head, Name, Arity),
  872      '$tbl_trienode'(Reserved)
  873    },
  874    qualify(Module,
  875            [ '$tabled'(Head, TMode),
  876              '$table_mode'(Head, Head, Reserved)
  877            ]),
  878    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
  879    ].
  880wrappers(ModeDirectedSpec, Module, Opts) -->
  881    { '$option'(mode(TMode), Opts, variant),
  882      callable(ModeDirectedSpec),
  883      !,
  884      functor(ModeDirectedSpec, Name, Arity),
  885      functor(Head, Name, Arity),
  886      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
  887      updater_clauses(Modes, Head, UpdateClauses),
  888      mode_check(Moded, ModeTest),
  889      (   ModeTest == true
  890      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts)
  891      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, ModeTest,
  892          Module:Variant, Moded)
  893      )
  894    },
  895    qualify(Module,
  896            [ '$tabled'(Head, TMode),
  897              '$table_mode'(Head, Variant, Moded)
  898            ]),
  899    [ (:- initialization(WrapClause, now))
  900    ],
  901    qualify(Module, UpdateClauses).
  902wrappers(TableSpec, _M, _Opts) -->
  903    { '$type_error'(table_desclaration, TableSpec)
  904    }.
  905
  906qualify(Module, List) -->
  907    { prolog_load_context(module, Module) },
  908    !,
  909    clist(List).
  910qualify(Module, List) -->
  911    qlist(List, Module).
  912
  913clist([])    --> [].
  914clist([H|T]) --> [H], clist(T).
  915
  916qlist([], _)    --> [].
  917qlist([H|T], M) --> [M:H], qlist(T, M).
 table_options(+Options, +OptDictIn, -OptDictOut)
Handler the ... as options ... construct.
  924table_options(Options, _Opts0, _Opts) :-
  925    var(Options),
  926    '$instantiation_error'(Options).
  927table_options((A,B), Opts0, Opts) :-
  928    !,
  929    table_options(A, Opts0, Opts1),
  930    table_options(B, Opts1, Opts).
  931table_options(subsumptive, Opts0, Opts1) :-
  932    !,
  933    put_dict(mode, Opts0, subsumptive, Opts1).
  934table_options(variant, Opts0, Opts1) :-
  935    !,
  936    put_dict(mode, Opts0, variant, Opts1).
  937table_options(incremental, Opts0, Opts1) :-
  938    !,
  939    put_dict(incremental, Opts0, true, Opts1).
  940table_options(dynamic, Opts0, Opts1) :-
  941    !,
  942    put_dict(dynamic, Opts0, true, Opts1).
  943table_options(shared, Opts0, Opts1) :-
  944    !,
  945    put_dict(tshared, Opts0, true, Opts1).
  946table_options(private, Opts0, Opts1) :-
  947    !,
  948    put_dict(tshared, Opts0, false, Opts1).
  949table_options(Opt, _, _) :-
  950    '$domain_error'(table_option, Opt).
 mode_check(+Moded, -TestCode)
Enforce the output arguments of a mode-directed tabled predicate to be unbound.
  957mode_check(Moded, Check) :-
  958    var(Moded),
  959    !,
  960    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
  961mode_check(Moded, true) :-
  962    '$tbl_trienode'(Moded),
  963    !.
  964mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
  965    Moded =.. [s|Vars],
  966    var_check(Vars, Test).
  967
  968var_check([H|T], Test) :-
  969    (   T == []
  970    ->  Test = var(H)
  971    ;   Test = (var(H),Rest),
  972        var_check(T, Rest)
  973    ).
  974
  975:- public
  976    instantiated_moded_arg/1.  977
  978instantiated_moded_arg(Vars) :-
  979    '$member'(V, Vars),
  980    \+ var(V),
  981    '$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,...)
  993extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
  994    compound(ModeSpec),
  995    !,
  996    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
  997    compound_name_arguments(Head, Name, HeadArgs),
  998    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
  999    length(ModedArgs, Count),
 1000    atomic_list_concat([$,Name,$,Count], VName),
 1001    Variant =.. [VName|VariantArgs],
 1002    (   ModedArgs == []
 1003    ->  '$tbl_trienode'(ModedAnswer)
 1004    ;   ModedArgs = [ModedAnswer]
 1005    ->  true
 1006    ;   ModedAnswer =.. [s|ModedArgs]
 1007    ).
 1008extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1009    atomic_list_concat([$,Atom,$,0], Variant),
 1010    '$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?
 1020separate_args([], [], [], [], []).
 1021separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1022    indexed_mode(HM),
 1023    !,
 1024    separate_args(TM, TA, TNA, Modes, TMA).
 1025separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1026    separate_args(TM, TA, TNA, Modes, TMA).
 1027
 1028indexed_mode(Mode) :-                           % XSB
 1029    var(Mode),
 1030    !.
 1031indexed_mode(index).                            % YAP
 1032indexed_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.
 1039updater_clauses([], _, []) :- !.
 1040updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1041    update_goal(P, S0,S1,S2, Body).
 1042updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1043    length(Modes, Len),
 1044    functor(S0, s, Len),
 1045    functor(S1, s, Len),
 1046    functor(S2, s, Len),
 1047    S0 =.. [_|Args0],
 1048    S1 =.. [_|Args1],
 1049    S2 =.. [_|Args2],
 1050    update_body(Modes, Args0, Args1, Args2, true, Body).
 1051
 1052update_body([], _, _, _, Body, Body).
 1053update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1054    update_goal(P, A0,A1,A2, Goal),
 1055    mkconj(Body0, Goal, Body1),
 1056    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1057
 1058update_goal(Var, _,_,_, _) :-
 1059    var(Var),
 1060    !,
 1061    '$instantiation_error'(Var).
 1062update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1063    !,
 1064    '$must_be'(atom, M),
 1065    update_goal(lattice(PI), S0,S1,S2, Goal).
 1066update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1067    !,
 1068    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1069    '$must_be'(atom, Name),
 1070    Goal =.. [Name,S0,S1,S2].
 1071update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1072    compound(Head),
 1073    !,
 1074    compound_name_arity(Head, Name, Arity),
 1075    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1076    Goal =.. [Name,S0,S1,S2].
 1077update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1078    !,
 1079    '$must_be'(atom, Name),
 1080    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1081update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1082    !,
 1083    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1084    '$must_be'(atom, Name),
 1085    Call =.. [Name, S0, S1],
 1086    Goal = (Call -> S2 = S0 ; S2 = S1).
 1087update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1088    !,
 1089    '$must_be'(atom, M),
 1090    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1091    '$must_be'(atom, Name),
 1092    Call =.. [Name, S0, S1],
 1093    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1094update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1095    !,
 1096    '$must_be'(atom, M),
 1097    '$must_be'(atom, Name),
 1098    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1099update_goal(po(Name), S0,S1,S2, Goal) :-
 1100    !,
 1101    '$must_be'(atom, Name),
 1102    update_goal(po(Name/2), S0,S1,S2, Goal).
 1103update_goal(Alias, S0,S1,S2, Goal) :-
 1104    update_alias(Alias, Update),
 1105    !,
 1106    update_goal(Update, S0,S1,S2, Goal).
 1107update_goal(Mode, _,_,_, _) :-
 1108    '$domain_error'(tabled_mode, Mode).
 1109
 1110update_alias(first, lattice('$tabling':first/3)).
 1111update_alias(-,     lattice('$tabling':first/3)).
 1112update_alias(last,  lattice('$tabling':last/3)).
 1113update_alias(min,   lattice('$tabling':min/3)).
 1114update_alias(max,   lattice('$tabling':max/3)).
 1115update_alias(sum,   lattice('$tabling':sum/3)).
 1116
 1117mkconj(true, G,  G) :- !.
 1118mkconj(G1,   G2, (G1,G2)).
 1119
 1120
 1121		 /*******************************
 1122		 *          AGGREGATION		*
 1123		 *******************************/
 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.
 1133:- public first/3, last/3, min/3, max/3, sum/3. 1134
 1135first(S, _, S).
 1136last(_, S, S).
 1137min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1138max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1139sum(S0, S1, S) :- S is S0+S1.
 1140
 1141
 1142		 /*******************************
 1143		 *      INCREMENTAL TABLING	*
 1144		 *******************************/
 $wrap_incremental(:Head) is det
Wrap an incremental dynamic predicate to be added to the IDG.
 1150'$wrap_incremental'(Head) :-
 1151    abstract_goal(Head, Abstract),
 1152    '$wrap_predicate'(Head, incremental, Wrapped,
 1153                      (   '$idg_add_dyncall'(Abstract),
 1154                          Wrapped
 1155                      )),
 1156    '$pi_head'(PI, Head),
 1157    (   Head == Abstract
 1158    ->  prolog_listen(PI, dyn_update)
 1159    ;   prolog_listen(PI, dyn_update(Abstract))
 1160    ).
 1161
 1162abstract_goal(M:Head, M:Abstract) :-
 1163    compound(Head),
 1164    '$get_predicate_attribute'(M:Head, abstract, 1),
 1165    !,
 1166    compound_name_arity(Head, Name, Arity),
 1167    functor(Abstract, Name, Arity).
 1168abstract_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.
 1178dyn_update(_Action, ClauseRef) :-
 1179    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1180    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1181        dyn_changed_pattern(Head)
 1182    ;   true
 1183    ).
 1184
 1185dyn_update(Abstract, _, _) :-
 1186    dyn_changed_pattern(Abstract).
 1187
 1188dyn_changed_pattern(Term) :-
 1189    '$tbl_variant_table'(VTable),
 1190    !,
 1191    forall(trie_gen(VTable, Term, ATrie),
 1192           '$idg_changed'(ATrie)).
 1193dyn_changed_pattern(_).
 $unwrap_incremental(:Head) is det
Remove dynamic predicate incremenal forwarding, reset the possible abstract property and remove possible tables.
 1200'$unwrap_incremental'(Head) :-
 1201    '$pi_head'(PI, Head),
 1202    (   unwrap_predicate(PI, incremental)
 1203    ->  abstract_goal(Head, Abstract),
 1204        (   Head == Abstract
 1205        ->  prolog_unlisten(PI, dyn_update)
 1206        ;   '$set_predicate_attribute'(Head, abstract, 0),
 1207            prolog_unlisten(PI, dyn_update(_))
 1208        ),
 1209        (   '$tbl_variant_table'(VariantTrie)
 1210        ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1211                   '$tbl_destroy_table'(ATrie))
 1212        ;   true
 1213        )
 1214    ;   true
 1215    ).
 reeval(+ATrie)
Called if the table ATrie is out-of-date (has non-zero falsecount). 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.
 1226reeval(ATrie) :-
 1227    findall(Path, false_path(ATrie, Path), Paths),
 1228    reeval_paths(Paths, ATrie).
 1229
 1230reeval_paths(BottomUp, ATrie) :-
 1231    is_invalid(ATrie),
 1232    !,
 1233    reeval_heads(BottomUp, ATrie, BottomUp1),
 1234    reeval_paths(BottomUp1, ATrie).
 1235reeval_paths(_, _).
 1236
 1237reeval_heads(_, ATrie, _) :-
 1238    \+ is_invalid(ATrie),
 1239    !.
 1240reeval_heads([], _, []).
 1241reeval_heads([[H]|B], ATrie, BT) :-
 1242    !,
 1243    reeval_node(H),
 1244    reeval_heads(B, ATrie, BT).
 1245reeval_heads([[]|B], ATrie, BT) :-
 1246    !,
 1247    reeval_heads(B, ATrie, BT).
 1248reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1249    !,
 1250    reeval_node(H),
 1251    reeval_heads(B, ATrie, BT).
 1252
 1253false_path(ATrie, BottomUp) :-
 1254    false_path(ATrie, Path, []),
 1255    '$reverse'(Path, BottomUp).
 1256
 1257false_path(ATrie, [ATrie|T], Seen) :-
 1258    is_invalid(ATrie),
 1259    \+ memberchk(ATrie, Seen),
 1260    '$idg_edge'(ATrie, dependent, Dep),
 1261    (   '$tbl_table_status'(Dep, dynamic, _, _),
 1262        T = []
 1263    ;   false_path(Dep, T, [ATrie|Seen])
 1264    ).
 1265
 1266is_invalid(ATrie) :-
 1267    '$idg_falsecount'(ATrie, FalseCount),
 1268    FalseCount > 0.
 1269
 1270reeval_node(ATrie) :-
 1271    is_invalid(ATrie),
 1272    !,
 1273    '$tbl_reeval_prepare'(ATrie),
 1274    '$tbl_table_status'(ATrie, _, Variant, _),
 1275    (   '$idg_reset_current',                   % move to '$tbl_scc_save'/1?
 1276        setup_call_cleanup(
 1277            '$tbl_scc_save'(State),
 1278            call(Variant),
 1279            '$tbl_scc_restore'(State)),
 1280        fail
 1281    ;   true
 1282    ).
 1283reeval_node(_).
 1284
 1285
 1286		 /*******************************
 1287		 *      EXPAND DIRECTIVES	*
 1288		 *******************************/
 1289
 1290system:term_expansion((:- table(Preds)), Expansion) :-
 1291    \+ current_prolog_flag(xref, true),
 1292    prolog_load_context(module, M),
 1293    phrase(wrappers(Preds, M), Clauses),
 1294    multifile_decls(Clauses, Directives0),
 1295    sort(Directives0, Directives),
 1296    '$append'(Directives, Clauses, Expansion).
 1297
 1298multifile_decls([], []).
 1299multifile_decls([H0|T0], [H|T]) :-
 1300    multifile_decl(H0, H),
 1301    !,
 1302    multifile_decls(T0, T).
 1303multifile_decls([_|T0], T) :-
 1304    multifile_decls(T0, T).
 1305
 1306multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 1307    !,
 1308    functor(Head, Name, Arity).
 1309multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 1310    !,
 1311    functor(Head, Name, Arity).
 1312multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 1313    !,
 1314    functor(Head, Name, Arity).
 1315multifile_decl(Head, (:- multifile(Name/Arity))) :-
 1316    !,
 1317    Head \= (:-_),
 1318    functor(Head, Name, Arity).
 1319
 1320
 1321		 /*******************************
 1322		 *      ANSWER COMPLETION	*
 1323		 *******************************/
 1324
 1325:- public answer_completion/2.
 answer_completion(+AnswerTrie, +Return) is det
Find positive loops in the residual program and remove the corresponding answers, possibly causing additional simplification. This is called from C if simplify_component() detects there are conditional answers after simplification.

Note that we are called recursively from C. Our caller prepared a clean new tabling environment and restores the old one after this predicate terminates.

author
- This code is by David Warren as part of XSB.
See also
- called from C, pl-tabling.c, answer_completion()
 1341answer_completion(AnswerTrie, Return) :-
 1342    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 1343    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 1344    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 1345                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 1346    (   Propagated > 0
 1347    ->  answer_completion(AnswerTrie, Return)
 1348    ;   true
 1349    ).
 1350
 1351answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 1352    (   eval_subgoal_in_residual(AnswerTrie, Return),
 1353        fail
 1354    ;   true
 1355    ),
 1356    delete_answers_for_failing_calls(Propagated),
 1357    (   Propagated == 0
 1358    ->  mark_succeeding_calls_as_answer_completed
 1359    ;   true
 1360    ).
 delete_answers_for_failing_calls(-Propagated)
Delete answers whose condition is determined to be false and return the number of additional answers that changed status as a consequence of additional simplification propagation.
 1368delete_answers_for_failing_calls(Propagated) :-
 1369    State = state(0),
 1370    (   subgoal_residual_trie(ASGF, ESGF),
 1371        \+ trie_gen(ESGF, _ETmp),
 1372        tdebug(trie_goal(ASGF, Goal0, _)),
 1373        tdebug(trie_goal(ASGF, Goal, _0Return)),
 1374        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 1375        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 1376	'$tbl_force_truth_value'(ALeaf, false, Count),
 1377        arg(1, State, Prop0),
 1378        Prop is Prop0+Count-1,
 1379        nb_setarg(1, State, Prop),
 1380	fail
 1381    ;   arg(1, State, Propagated)
 1382    ).
 1383
 1384mark_succeeding_calls_as_answer_completed :-
 1385    (   subgoal_residual_trie(ASGF, _ESGF),
 1386        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 1387        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 1388            tdebug(trie_goal(ASGF, Goal, _0Return)),
 1389            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 1390            '$tbl_set_answer_completed'(ASGF)
 1391        ),
 1392        fail
 1393    ;   true
 1394    ).
 1395
 1396subgoal_residual_trie(ASGF, ESGF) :-
 1397    '$tbl_variant_table'(VariantTrie),
 1398    context_module(M),
 1399    trie_gen(VariantTrie, M:eval_subgoal_in_residual(ASGF, _), ESGF).
 eval_dl_in_residual(+Condition)
Evaluate a condition by only looking at the residual goals of the involved calls.
 1406eval_dl_in_residual(true) :-
 1407    !.
 1408eval_dl_in_residual((A;B)) :-
 1409    !,
 1410    (   eval_dl_in_residual(A)
 1411    ;   eval_dl_in_residual(B)
 1412    ).
 1413eval_dl_in_residual((A,B)) :-
 1414    !,
 1415    eval_dl_in_residual(A),
 1416    eval_dl_in_residual(B).
 1417eval_dl_in_residual(tnot(G)) :-
 1418    !,
 1419    tdebug(ac, ' ? tnot(~p)', [G]),
 1420    current_table(G, SGF),
 1421    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 1422    tnot(eval_subgoal_in_residual(SGF, Return)).
 1423eval_dl_in_residual(G) :-
 1424    tdebug(ac, ' ? ~p', [G]),
 1425    (   current_table(G, SGF)
 1426    ->	true
 1427    ;   more_general_table(G, SGF)
 1428    ->	true
 1429    ;	writeln(user_error, 'MISSING CALL? '(G)),
 1430        fail
 1431    ),
 1432    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 1433    eval_subgoal_in_residual(SGF, Return).
 1434
 1435more_general_table(G, Trie) :-
 1436    term_variables(G, Vars),
 1437    length(Vars, Len),
 1438    '$tbl_variant_table'(VariantTrie),
 1439    trie_gen(VariantTrie, G, Trie),
 1440    all_vars(Vars),
 1441    sort(Vars, V2),
 1442    length(V2, Len).
 1443
 1444all_vars([]).
 1445all_vars([H|T]) :-
 1446    var(H),
 1447    all_vars(T).
 1448
 1449:- table eval_subgoal_in_residual/2.
 eval_subgoal_in_residual(+AnswerTrie, ?Return)
Derive answers for the variant represented by AnswerTrie based on the residual goals only.
 1456eval_subgoal_in_residual(AnswerTrie, _Return) :-
 1457    '$tbl_is_answer_completed'(AnswerTrie),
 1458    !,
 1459    undefined.
 1460eval_subgoal_in_residual(AnswerTrie, Return) :-
 1461    '$tbl_answer'(AnswerTrie, Return, Condition),
 1462    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 1463    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 1464    eval_dl_in_residual(Condition).
 undefined
Expresses the value bottom from the well founded semantics.
 1470:- table
 1471    undefined/0. 1472
 1473undefined :-
 1474    tnot(undefined)