View source with formatted 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-2021, 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, :).   86
   87/** <module> Tabled execution (SLG WAM)
   88
   89This  library  handled  _tabled_  execution   of  predicates  using  the
   90characteristics if the _SLG WAM_. The   required  suspension is realised
   91using _delimited continuations_ implemented by  reset/3 and shift/1. The
   92table space and work lists are part of the SWI-Prolog core.
   93
   94@author Benoit Desouter, Jan Wielemaker and Fabrizio Riguzzi
   95*/
   96
   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)).  118wl_goal(tnot(WorkList), ~(Goal), Skeleton) :-
  119    !,
  120    '$tbl_wkl_table'(WorkList, ATrie),
  121    trie_goal(ATrie, Goal, Skeleton).
  122wl_goal(WorkList, Goal, Skeleton) :-
  123    '$tbl_wkl_table'(WorkList, ATrie),
  124    trie_goal(ATrie, Goal, Skeleton).
  125
  126trie_goal(ATrie, Goal, Skeleton) :-
  127    '$tbl_table_status'(ATrie, _Status, M:Variant, Skeleton),
  128    (   M:'$table_mode'(Goal0, Variant, _Moded)
  129    ->  true
  130    ;   Goal0 = Variant                 % dynamic IDG nodes
  131    ),
  132    unqualify_goal(M:Goal0, user, Goal).
  133
  134delay_goals(List, Goal) :-
  135    delay_goals(List, user, Goal).
  136
  137user_goal(Goal, UGoal) :-
  138    unqualify_goal(Goal, user, UGoal).
  139
  140:- multifile
  141    prolog:portray/1.  142
  143user:portray(ATrie) :-
  144    '$is_answer_trie'(ATrie, _),
  145    trie_goal(ATrie, Goal, _Skeleton),
  146    (   '$idg_falsecount'(ATrie, FalseCount)
  147    ->  (   '$idg_forced'(ATrie)
  148        ->  format('~q [fc=~d/F] for ~p', [ATrie, FalseCount, Goal])
  149        ;   format('~q [fc=~d] for ~p', [ATrie, FalseCount, Goal])
  150        )
  151    ;   format('~q for ~p', [ATrie, Goal])
  152    ).
  153user:portray(Cont) :-
  154    compound(Cont),
  155    compound_name_arguments(Cont, '$cont$', [_Context, Clause, PC | Args]),
  156    clause_property(Clause, file(File)),
  157    file_base_name(File, Base),
  158    clause_property(Clause, line_count(Line)),
  159    clause_property(Clause, predicate(PI)),
  160    format('~q at ~w:~d @PC=~w, ~p', [PI, Base, Line, PC, Args]).
  161
  162:- endif.  163
  164%!  table(:PredicateIndicators)
  165%
  166%   Prepare the given PredicateIndicators for tabling. This predicate is
  167%   normally used as a directive,  but   SWI-Prolog  also allows runtime
  168%   conversion of non-tabled predicates to  tabled predicates by calling
  169%   table/1. The example below prepares  the   predicate  edge/2 and the
  170%   non-terminal statement//1 for tabled execution.
  171%
  172%     ==
  173%     :- table edge/2, statement//1.
  174%     ==
  175%
  176%   In addition to using _predicate  indicators_,   a  predicate  can be
  177%   declared for _mode  directed  tabling_  using   a  term  where  each
  178%   argument declares the intended mode.  For example:
  179%
  180%     ==
  181%     :- table connection(_,_,min).
  182%     ==
  183%
  184%   _Mode directed tabling_ is  discussed   in  the general introduction
  185%   section about tabling.
  186
  187table(M:PIList) :-
  188    setup_call_cleanup(
  189        '$set_source_module'(OldModule, M),
  190        expand_term((:- table(PIList)), Clauses),
  191        '$set_source_module'(OldModule)),
  192    dyn_tabling_list(Clauses, M).
  193
  194dyn_tabling_list([], _).
  195dyn_tabling_list([H|T], M) :-
  196    dyn_tabling(H, M),
  197    dyn_tabling_list(T, M).
  198
  199dyn_tabling(M:Clause, _) :-
  200    !,
  201    dyn_tabling(Clause, M).
  202dyn_tabling((:- multifile(PI)), M) :-
  203    !,
  204    multifile(M:PI),
  205    dynamic(M:PI).
  206dyn_tabling(:- initialization(Wrap, now), M) :-
  207    !,
  208    M:Wrap.
  209dyn_tabling('$tabled'(Head, TMode), M) :-
  210    (   clause(M:'$tabled'(Head, OMode), true, Ref),
  211        (   OMode \== TMode
  212        ->  erase(Ref),
  213            fail
  214        ;   true
  215        )
  216    ->  true
  217    ;   assertz(M:'$tabled'(Head, TMode))
  218    ).
  219dyn_tabling('$table_mode'(Head, Variant, Moded), M) :-
  220    (   clause(M:'$table_mode'(Head, Variant0, Moded0), true, Ref)
  221    ->  (   t(Head, Variant, Moded) =@= t(Head, Variant0, Moded0)
  222        ->  true
  223        ;   erase(Ref),
  224            assertz(M:'$table_mode'(Head, Variant, Moded))
  225        )
  226    ;   assertz(M:'$table_mode'(Head, Variant, Moded))
  227    ).
  228dyn_tabling(('$table_update'(Head, S0, S1, S2) :- Body), M) :-
  229    (   clause(M:'$table_update'(Head, S00, S10, S20), Body0, Ref)
  230    ->  (   t(Head, S0, S1, S2, Body) =@= t(Head, S00, S10, S20, Body0)
  231        ->  true
  232        ;   erase(Ref),
  233            assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  234        )
  235    ;   assertz(M:('$table_update'(Head, S0, S1, S2) :- Body))
  236    ).
  237
  238%!  untable(M:PIList) is det.
  239%
  240%   Remove tabling for the predicates in  PIList.   This  can be used to
  241%   undo the effect of table/1 at runtime.   In addition to removing the
  242%   tabling instrumentation this also removes possibly associated tables
  243%   using abolish_table_subgoals/1.
  244%
  245%   @arg PIList is a comma-list that is compatible ith table/1.
  246
  247untable(M:PIList) :-
  248    untable(PIList, M).
  249
  250untable(Var, _) :-
  251    var(Var),
  252    !,
  253    '$instantiation_error'(Var).
  254untable(M:Spec, _) :-
  255    !,
  256    '$must_be'(atom, M),
  257    untable(Spec, M).
  258untable((A,B), M) :-
  259    !,
  260    untable(A, M),
  261    untable(B, M).
  262untable(Name//Arity, M) :-
  263    atom(Name), integer(Arity), Arity >= 0,
  264    !,
  265    Arity1 is Arity+2,
  266    untable(Name/Arity1, M).
  267untable(Name/Arity, M) :-
  268    !,
  269    functor(Head, Name, Arity),
  270    (   '$get_predicate_attribute'(M:Head, tabled, 1)
  271    ->  abolish_table_subgoals(M:Head),
  272        dynamic(M:'$tabled'/2),
  273        dynamic(M:'$table_mode'/3),
  274        retractall(M:'$tabled'(Head, _TMode)),
  275        retractall(M:'$table_mode'(Head, _Variant, _Moded)),
  276        unwrap_predicate(M:Name/Arity, table),
  277        '$set_predicate_attribute'(M:Head, tabled, false),
  278        '$set_predicate_attribute'(M:Head, opaque, false),
  279        '$set_predicate_attribute'(M:Head, incremental, false),
  280        '$set_predicate_attribute'(M:Head, monotonic, false),
  281        '$set_predicate_attribute'(M:Head, lazy, false)
  282    ;   true
  283    ).
  284untable(Head, M) :-
  285    callable(Head),
  286    !,
  287    functor(Head, Name, Arity),
  288    untable(Name/Arity, M).
  289untable(TableSpec, _) :-
  290    '$type_error'(table_desclaration, TableSpec).
  291
  292untable_reconsult(PI) :-
  293    print_message(informational, untable(PI)),
  294    untable(PI).
  295
  296:- initialization
  297   prolog_listen(untable, untable_reconsult).  298
  299
  300'$wrap_tabled'(Head, Options) :-
  301    get_dict(mode, Options, subsumptive),
  302    !,
  303    set_pattributes(Head, Options),
  304    '$wrap_predicate'(Head, table, Closure, Wrapped,
  305                      start_subsumptive_tabling(Closure, Head, Wrapped)).
  306'$wrap_tabled'(Head, Options) :-
  307    get_dict(subgoal_abstract, Options, _Abstract),
  308    !,
  309    set_pattributes(Head, Options),
  310    '$wrap_predicate'(Head, table, Closure, Wrapped,
  311                      start_abstract_tabling(Closure, Head, Wrapped)).
  312'$wrap_tabled'(Head, Options) :-
  313    !,
  314    set_pattributes(Head, Options),
  315    '$wrap_predicate'(Head, table, Closure, Wrapped,
  316                      start_tabling(Closure, Head, Wrapped)).
  317
  318%!  set_pattributes(:Head, +Options) is det.
  319%
  320%   Set all tabling attributes for Head. These have been collected using
  321%   table_options/3 from the `:- table Head as (Attr1,...)` directive.
  322
  323set_pattributes(Head, Options) :-
  324    '$set_predicate_attribute'(Head, tabled, true),
  325    (   tabled_attribute(Attr),
  326        get_dict(Attr, Options, Value),
  327        '$set_predicate_attribute'(Head, Attr, Value),
  328        fail
  329    ;   current_prolog_flag(table_monotonic, lazy),
  330        '$set_predicate_attribute'(Head, lazy, true),
  331        fail
  332    ;   true
  333    ).
  334
  335tabled_attribute(incremental).
  336tabled_attribute(dynamic).
  337tabled_attribute(tshared).
  338tabled_attribute(max_answers).
  339tabled_attribute(subgoal_abstract).
  340tabled_attribute(answer_abstract).
  341tabled_attribute(monotonic).
  342tabled_attribute(opaque).
  343tabled_attribute(lazy).
  344
  345%!  start_tabling(:Closure, :Wrapper, :Implementation)
  346%
  347%   Execute Implementation using tabling. This   predicate should not be
  348%   called directly. The table/1 directive  causes   a  predicate  to be
  349%   translated into a renamed implementation and a wrapper that involves
  350%   this predicate.
  351%
  352%   @arg Closure is the wrapper closure   to find the predicate quickly.
  353%   It is also allowed to pass nothing.   In that cases the predicate is
  354%   looked up using Wrapper.  We suggest to pass `0` in this case.
  355%
  356%   @compat This interface may change or disappear without notice
  357%           from future versions.
  358
  359start_tabling(Closure, Wrapper, Worker) :-
  360    '$tbl_variant_table'(Closure, Wrapper, Trie, Status, Skeleton, IsMono),
  361    (   IsMono == true
  362    ->  shift(dependency(Skeleton, Trie, Mono)),
  363        (   Mono == true
  364        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  365        ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  366        )
  367    ;   start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  368    ).
  369
  370start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton) :-
  371    tdebug(deadlock, 'Got table ~p, status ~p', [Trie, Status]),
  372    (   Status == complete
  373    ->  trie_gen_compiled(Trie, Skeleton)
  374    ;   functor(Status, fresh, 2)
  375    ->  catch(create_table(Trie, Status, Skeleton, Wrapper, Worker),
  376              deadlock,
  377              restart_tabling(Closure, Wrapper, Worker))
  378    ;   Status == invalid
  379    ->  reeval(Trie, Wrapper, Skeleton)
  380    ;   % = run_follower, but never fresh and Status is a worklist
  381        shift_for_copy(call_info(Skeleton, Status))
  382    ).
  383
  384create_table(Trie, Fresh, Skeleton, Wrapper, Worker) :-
  385    tdebug(Fresh = fresh(SCC, WorkList)),
  386    tdebug(wl_goal(WorkList, Goal, _)),
  387    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  388    setup_call_catcher_cleanup(
  389        '$idg_set_current'(OldCurrent, Trie),
  390        run_leader(Skeleton, Worker, Fresh, LStatus, Clause),
  391        Catcher,
  392        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  393    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  394    done_leader(LStatus, Fresh, Skeleton, Clause).
  395
  396%!  restart_tabling(+Closure, +Wrapper, +Worker)
  397%
  398%   We were aborted due to a  deadlock.   Simply  retry. We sleep a very
  399%   tiny amount to give the thread against  which we have deadlocked the
  400%   opportunity to grab our table. Without, it is common that we re-grab
  401%   the table within our time slice  and   before  the kernel managed to
  402%   wakeup the other thread.
  403
  404restart_tabling(Closure, Wrapper, Worker) :-
  405    tdebug(user_goal(Wrapper, Goal)),
  406    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  407    sleep(0.000001),
  408    start_tabling(Closure, Wrapper, Worker).
  409
  410restart_abstract_tabling(Closure, Wrapper, Worker) :-
  411    tdebug(user_goal(Wrapper, Goal)),
  412    tdebug(deadlock, 'Deadlock running ~p; retrying', [Goal]),
  413    sleep(0.000001),
  414    start_abstract_tabling(Closure, Wrapper, Worker).
  415
  416%!  start_subsumptive_tabling(:Closure, :Wrapper, :Implementation)
  417%
  418%   (*) We should __not__ use  trie_gen_compiled/2   here  as  this will
  419%   enumerate  all  answers  while  '$tbl_answer_update_dl'/2  uses  the
  420%   available trie indexing to only fetch the relevant answer(s).
  421%
  422%   @tbd  In  the  end  '$tbl_answer_update_dl'/2  is  problematic  with
  423%   incremental and shared tabling  as  we   do  not  get the consistent
  424%   update view from the compiled result.
  425
  426start_subsumptive_tabling(Closure, Wrapper, Worker) :-
  427    (   '$tbl_existing_variant_table'(Closure, Wrapper, Trie, Status, Skeleton)
  428    ->  (   Status == complete
  429        ->  trie_gen_compiled(Trie, Skeleton)
  430        ;   Status == invalid
  431        ->  reeval(Trie, Wrapper, Skeleton),
  432            trie_gen_compiled(Trie, Skeleton)
  433        ;   shift_for_copy(call_info(Skeleton, Status))
  434        )
  435    ;   more_general_table(Wrapper, ATrie),
  436        '$tbl_table_status'(ATrie, complete, Wrapper, Skeleton)
  437    ->  '$tbl_answer_update_dl'(ATrie, Skeleton) % see (*)
  438    ;   more_general_table(Wrapper, ATrie),
  439        '$tbl_table_status'(ATrie, Status, GenWrapper, GenSkeleton)
  440    ->  (   Status == invalid
  441        ->  reeval(ATrie, GenWrapper, GenSkeleton),
  442            Wrapper = GenWrapper,
  443            '$tbl_answer_update_dl'(ATrie, GenSkeleton)
  444        ;   wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton),
  445            shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  446            unify_subsumptive(Skeleton, GenSkeleton)
  447        )
  448    ;   start_tabling(Closure, Wrapper, Worker)
  449    ).
  450
  451%!  wrapper_skeleton(+GenWrapper, +GenSkeleton, +Wrapper, -Skeleton)
  452%
  453%   Skeleton is a specialized version of   GenSkeleton  for the subsumed
  454%   new consumer.
  455
  456wrapper_skeleton(GenWrapper, GenSkeleton, Wrapper, Skeleton) :-
  457    copy_term(GenWrapper+GenSkeleton, Wrapper+Skeleton),
  458    tdebug(call_subsumption, 'GenSkeleton+Skeleton = ~p',
  459           [GenSkeleton+Skeleton]).
  460
  461unify_subsumptive(X,X).
  462
  463%!  start_abstract_tabling(:Closure, :Wrapper, :Worker)
  464%
  465%   Deal with ``table p/1 as  subgoal_abstract(N)``.   This  is  a merge
  466%   between  variant  and  subsumptive  tabling.  If  the  goal  is  not
  467%   abstracted this is simple variant tabling. If the goal is abstracted
  468%   we must solve the  more  general  goal   and  use  answers  from the
  469%   abstract table.
  470%
  471%   Wrapper is e.g., user:p(s(s(s(X))),Y)
  472%   Worker  is e.g., call(<closure>(p/2)(s(s(s(X))),Y))
  473
  474start_abstract_tabling(Closure, Wrapper, Worker) :-
  475    '$tbl_abstract_table'(Closure, Wrapper, Trie, _Abstract, Status, Skeleton),
  476    tdebug(abstract, 'Wrapper=~p, Worker=~p, Skel=~p',
  477           [Wrapper, Worker, Skeleton]),
  478    (   is_most_general_term(Skeleton)           % TBD: Fill and test Abstract
  479    ->  start_tabling_2(Closure, Wrapper, Worker, Trie, Status, Skeleton)
  480    ;   Status == complete
  481    ->  '$tbl_answer_update_dl'(Trie, Skeleton)
  482    ;   functor(Status, fresh, 2)
  483    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  484        abstract_worker(Worker, GenWrapper, GenWorker),
  485        catch(create_abstract_table(Trie, Status, Skeleton, GenSkeleton, GenWrapper,
  486                                    GenWorker),
  487              deadlock,
  488              restart_abstract_tabling(Closure, Wrapper, Worker))
  489    ;   Status == invalid
  490    ->  '$tbl_table_status'(Trie, _, GenWrapper, GenSkeleton),
  491        reeval(ATrie, GenWrapper, GenSkeleton),
  492        Wrapper = GenWrapper,
  493        '$tbl_answer_update_dl'(ATrie, Skeleton)
  494    ;   shift_for_copy(call_info(GenSkeleton, Skeleton, Status)),
  495        unify_subsumptive(Skeleton, GenSkeleton)
  496    ).
  497
  498create_abstract_table(Trie, Fresh, Skeleton, GenSkeleton, Wrapper, Worker) :-
  499    tdebug(Fresh = fresh(SCC, WorkList)),
  500    tdebug(wl_goal(WorkList, Goal, _)),
  501    tdebug(schedule, 'Created component ~d for ~p', [SCC, Goal]),
  502    setup_call_catcher_cleanup(
  503        '$idg_set_current'(OldCurrent, Trie),
  504        run_leader(GenSkeleton, Worker, Fresh, LStatus, _Clause),
  505        Catcher,
  506        finished_leader(OldCurrent, Catcher, Fresh, Wrapper)),
  507    tdebug(schedule, 'Leader ~p done, status = ~p', [Goal, LStatus]),
  508    Skeleton = GenSkeleton,
  509    done_abstract_leader(LStatus, Fresh, GenSkeleton, Trie).
  510
  511abstract_worker(_:call(Term), _M:GenWrapper, call(GenTerm)) :-
  512    functor(Term, Closure, _),
  513    GenWrapper =.. [_|Args],
  514    GenTerm =.. [Closure|Args].
  515
  516:- '$hide'((done_abstract_leader/4)).  517
  518done_abstract_leader(complete, _Fresh, Skeleton, Trie) :-
  519    !,
  520    '$tbl_answer_update_dl'(Trie, Skeleton).
  521done_abstract_leader(final, fresh(SCC, _Worklist), Skeleton, Trie) :-
  522    !,
  523    '$tbl_free_component'(SCC),
  524    '$tbl_answer_update_dl'(Trie, Skeleton).
  525done_abstract_leader(_,_,_,_).
  526
  527%!  done_leader(+Status, +Fresh, +Skeleton, -Clause)
  528%
  529%   Called on completion of a table. Possibly destroys the component and
  530%   generates the answers from the complete  table. The last cases deals
  531%   with leaders that are merged into a higher SCC (and thus no longer a
  532%   leader).
  533
  534:- '$hide'((done_leader/4, finished_leader/4)).  535
  536done_leader(complete, _Fresh, Skeleton, Clause) :-
  537    !,
  538    trie_gen_compiled(Clause, Skeleton).
  539done_leader(final, fresh(SCC, _Worklist), Skeleton, Clause) :-
  540    !,
  541    '$tbl_free_component'(SCC),
  542    trie_gen_compiled(Clause, Skeleton).
  543done_leader(_,_,_,_).
  544
  545finished_leader(OldCurrent, Catcher, Fresh, Wrapper) :-
  546    '$idg_set_current'(OldCurrent),
  547    (   Catcher == exit
  548    ->  true
  549    ;   Catcher == fail
  550    ->  true
  551    ;   Catcher = exception(_)
  552    ->  Fresh = fresh(SCC, _),
  553        '$tbl_table_discard_all'(SCC)
  554    ;   print_message(error, tabling(unexpected_result(Wrapper, Catcher)))
  555    ).
  556
  557%!  run_leader(+Skeleton, +Worker, +Fresh, -Status, -Clause) is det.
  558%
  559%   Run the leader of  a  (new)   SCC,  storing  instantiated  copies of
  560%   Wrapper into Trie. Status  is  the  status   of  the  SCC  when this
  561%   predicate terminates. It is one of   `complete`, in which case local
  562%   completion finished or `merged` if running   the completion finds an
  563%   open (not completed) active goal that resides in a parent component.
  564%   In this case, this SCC has been merged with this parent.
  565%
  566%   If the SCC is merged, the answers   it already gathered are added to
  567%   the worklist and we shift  (suspend),   turning  our  leader into an
  568%   internal node for the upper SCC.
  569
  570run_leader(Skeleton, Worker, fresh(SCC, Worklist), Status, Clause) :-
  571    tdebug(wl_goal(Worklist, Goal, Skeleton)),
  572    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  573    activate(Skeleton, Worker, Worklist),
  574    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  575    completion(SCC, Status, Clause),
  576    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  577    (   Status == merged
  578    ->  tdebug(merge, 'Turning leader ~p into follower', [Goal]),
  579        '$tbl_wkl_make_follower'(Worklist),
  580        shift_for_copy(call_info(Skeleton, Worklist))
  581    ;   true                                    % completed
  582    ).
  583
  584activate(Skeleton, Worker, WorkList) :-
  585    tdebug(activate, '~p: created wl=~p', [Skeleton, WorkList]),
  586    (   reset_delays,
  587        delim(Skeleton, Worker, WorkList, []),
  588        fail
  589    ;   true
  590    ).
  591
  592%!  delim(+Skeleton, +Worker, +WorkList, +Delays)
  593%
  594%   Call WorkList and  add  all  instances   of  Skeleton  as  answer to
  595%   WorkList, conditional according to Delays.
  596%
  597%   @arg Skeleton is the return skeleton (ret/N term)
  598%   @arg Worker is either the (wrapped) tabled goal or a _continuation_
  599%   @arg WorkList is the work list associated with Worker (or its
  600%        continuation).
  601%   @arg Delays is the current delay list.  Note that the actual delay
  602%        also include the internal global delay list.
  603%        '$tbl_wkl_add_answer'/4 joins the two.  For a dependency we
  604%        join the two explicitly.
  605
  606delim(Skeleton, Worker, WorkList, Delays) :-
  607    reset(Worker, SourceCall, Continuation),
  608    tdebug(wl_goal(WorkList, Goal, _)),
  609    (   Continuation == 0
  610    ->  tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  611        tdebug(delay_goals(AllDelays, Cond)),
  612        tdebug(answer, 'New answer ~p for ~p (delays = ~p)',
  613               [Skeleton, Goal, Cond]),
  614        '$tbl_wkl_add_answer'(WorkList, Skeleton, Delays, Complete),
  615        Complete == !,
  616        !
  617    ;   SourceCall = call_info(SrcSkeleton, SourceWL)
  618    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  619        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  620        tdebug(wl_goal(WorkList, DstGoal, _)),
  621        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  622        '$tbl_wkl_add_suspension'(
  623            SourceWL,
  624            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  625    ;   SourceCall = call_info(SrcSkeleton, InstSkeleton, SourceWL)
  626    ->  '$tbl_add_global_delays'(Delays, AllDelays),
  627        tdebug(wl_goal(SourceWL, SrcGoal, _)),
  628        tdebug(wl_goal(WorkList, DstGoal, _)),
  629        tdebug(schedule, 'Suspended ~p, for solving ~p', [SrcGoal, DstGoal]),
  630        '$tbl_wkl_add_suspension'(
  631            SourceWL,
  632            InstSkeleton,
  633            dependency(SrcSkeleton, Continuation, Skeleton, WorkList, AllDelays))
  634    ;   '$tbl_wkl_table'(WorkList, ATrie),
  635        mon_assert_dep(SourceCall, Continuation, Skeleton, ATrie)
  636    ->  delim(Skeleton, Continuation, WorkList, Delays)
  637    ).
  638
  639%!  start_moded_tabling(+Closure, :Wrapper, :Implementation, +Variant, +ModeArgs)
  640%
  641%   As start_tabling/2, but in addition separates the data stored in the
  642%   answer trie in the Variant and ModeArgs.
  643
  644'$moded_wrap_tabled'(Head, Options, ModeTest, WrapperNoModes, ModeArgs) :-
  645    set_pattributes(Head, Options),
  646    '$wrap_predicate'(Head, table, Closure, Wrapped,
  647                      (   ModeTest,
  648                          start_moded_tabling(Closure, Head, Wrapped,
  649                                              WrapperNoModes, ModeArgs)
  650                      )).
  651
  652
  653start_moded_tabling(Closure, Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  654    '$tbl_moded_variant_table'(Closure, WrapperNoModes, Trie,
  655                               Status, Skeleton, IsMono),
  656    (   IsMono == true
  657    ->  shift(dependency(Skeleton/ModeArgs, Trie, Mono)),
  658        (   Mono == true
  659        ->  tdebug(monotonic, 'Monotonic new answer: ~p', [Skeleton])
  660        ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  661                                  Trie, Status, Skeleton)
  662        )
  663    ;   start_moded_tabling_2(Closure, Wrapper, Worker, ModeArgs,
  664                              Trie, Status, Skeleton)
  665    ).
  666
  667start_moded_tabling_2(_Closure, Wrapper, Worker, ModeArgs,
  668                      Trie, Status, Skeleton) :-
  669    (   Status == complete
  670    ->  moded_gen_answer(Trie, Skeleton, ModeArgs)
  671    ;   functor(Status, fresh, 2)
  672    ->  setup_call_catcher_cleanup(
  673            '$idg_set_current'(OldCurrent, Trie),
  674            moded_run_leader(Wrapper, Skeleton/ModeArgs,
  675                             Worker, Status, LStatus),
  676            Catcher,
  677            finished_leader(OldCurrent, Catcher, Status, Wrapper)),
  678        tdebug(schedule, 'Leader ~p done, modeargs = ~p, status = ~p',
  679               [Wrapper, ModeArgs, LStatus]),
  680        moded_done_leader(LStatus, Status, Skeleton, ModeArgs, Trie)
  681    ;   Status == invalid
  682    ->  reeval(Trie, Wrapper, Skeleton),
  683        moded_gen_answer(Trie, Skeleton, ModeArgs)
  684    ;   % = run_follower, but never fresh and Status is a worklist
  685        shift_for_copy(call_info(Skeleton/ModeArgs, Status))
  686    ).
  687
  688:- public
  689    moded_gen_answer/3.                         % XSB tables.pl
  690
  691moded_gen_answer(Trie, Skeleton, ModedArgs) :-
  692    trie_gen(Trie, Skeleton),
  693    '$tbl_answer_update_dl'(Trie, Skeleton, ModedArgs).
  694
  695'$tbl_answer'(ATrie, Skeleton, ModedArgs, Delay) :-
  696    trie_gen(ATrie, Skeleton),
  697    '$tbl_answer_c'(ATrie, Skeleton, ModedArgs, Delay).
  698
  699moded_done_leader(complete, _Fresh, Skeleton, ModeArgs, Trie) :-
  700    !,
  701    moded_gen_answer(Trie, Skeleton, ModeArgs).
  702moded_done_leader(final, fresh(SCC, _WorkList), Skeleton, ModeArgs, Trie) :-
  703    !,
  704    '$tbl_free_component'(SCC),
  705    moded_gen_answer(Trie, Skeleton, ModeArgs).
  706moded_done_leader(_, _, _, _, _).
  707
  708moded_run_leader(Wrapper, SkeletonMA, Worker, fresh(SCC, Worklist), Status) :-
  709    tdebug(wl_goal(Worklist, Goal, _)),
  710    tdebug(schedule, '-> Activate component ~p for ~p', [SCC, Goal]),
  711    moded_activate(SkeletonMA, Worker, Worklist),
  712    tdebug(schedule, '-> Complete component ~p for ~p', [SCC, Goal]),
  713    completion(SCC, Status, _Clause),           % TBD: propagate
  714    tdebug(schedule, '-> Completed component ~p for ~p: ~p', [SCC, Goal, Status]),
  715    (   Status == merged
  716    ->  tdebug(merge, 'Turning leader ~p into follower', [Wrapper]),
  717        '$tbl_wkl_make_follower'(Worklist),
  718        shift_for_copy(call_info(SkeletonMA, Worklist))
  719    ;   true                                    % completed
  720    ).
  721
  722moded_activate(SkeletonMA, Worker, WorkList) :-
  723    (   reset_delays,
  724        delim(SkeletonMA, Worker, WorkList, []),
  725        fail
  726    ;   true
  727    ).
  728
  729%!  update(+Flags, +Head, +Module, +A1, +A2, -A3, -Action) is semidet.
  730%
  731%   Update the aggregated value  for  an   answer.  Iff  this  predicate
  732%   succeeds, the aggregated value is updated to   A3. If Del is unified
  733%   with `true`, A1 should be deleted.
  734%
  735%   @arg Flags is a bit mask telling which of A1 and A2 are uncondional
  736%   @arg Head is the head of the predicate
  737%   @arg Module is the module of the predicate
  738%   @arg A1 is the currently aggregated value
  739%   @arg A2 is the newly produced value
  740%   @arg Action is one of
  741%	 - `delete` to replace the old answer with the new
  742%	 - `keep`   to keep the old answer and add the new
  743%	 - `done`   to stop the update process
  744
  745:- public
  746    update/7.  747
  748update(0b11, Wrapper, M, A1, A2, A3, delete) :-
  749    !,
  750    M:'$table_update'(Wrapper, A1, A2, A3),
  751    A1 \=@= A3.
  752update(0b10, Wrapper, M, A1, A2, A3, Action) :-
  753    !,
  754    (   is_subsumed_by(Wrapper, M, A2, A1)
  755    ->  Action = done
  756    ;   A3 = A2,
  757        Action = keep
  758    ).
  759update(0b01, Wrapper, M, A1, A2, A2, Action) :-
  760    !,
  761    (   is_subsumed_by(Wrapper, M, A1, A2)
  762    ->  Action = delete
  763    ;   Action = keep
  764    ).
  765update(0b00, _Wrapper, _M, _A1, A2, A2, keep) :-
  766    !.
  767
  768is_subsumed_by(Wrapper, M, Instance, General) :-
  769    M:'$table_update'(Wrapper, Instance, General, New),
  770    New =@= General.
  771
  772%!  completion(+Component, -Status, -Clause) is det.
  773%
  774%   Wakeup suspended goals until no new answers are generated. Status is
  775%   one of `merged`, `completed` or `final`.  If Status is not `merged`,
  776%   Clause is a compiled  representation  for   the  answer  trie of the
  777%   Component leader.
  778
  779completion(SCC, Status, Clause) :-
  780    (   reset_delays,
  781        completion_(SCC),
  782        fail
  783    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  784        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  785    ).
  786
  787completion_(SCC) :-
  788    repeat,
  789    (   '$tbl_pop_worklist'(SCC, WorkList)
  790    ->  tdebug(wl_goal(WorkList, Goal, _)),
  791        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  792        completion_step(WorkList)
  793    ;   !
  794    ).
  795
  796%!  '$tbl_wkl_work'(+WorkList,
  797%!                  -Answer,
  798%!                  -Continuation, -Wrapper, -TargetWorklist,
  799%!                  -Delays) is nondet.
  800%
  801%   True when Continuation needs to run with Answer and possible answers
  802%   need to be added to  TargetWorklist.   The  remaining  arguments are
  803%   there to restore variable bindings and restore the delay list.
  804%
  805%   The  suspension  added  by  '$tbl_wkl_add_suspension'/2  is  a  term
  806%   dependency(SrcWrapper,  Continuation,  Wrapper,  WorkList,  Delays).
  807%   Note that:
  808%
  809%     - Answer and Goal must be unified to rebind the _input_ arguments
  810%       for the continuation.
  811%     - Wrapper is stored in TargetWorklist on successful completion
  812%       of the Continuation.
  813%     - If Answer Subsumption is in effect, the story is a bit more
  814%       complex and ModeArgs provide the binding over which we do
  815%       _aggregation_. Otherwise, ModeArgs is the the
  816%       reserved trie node produced by '$tbl_trienode'/1.
  817%
  818%   @arg Answer is the answer term from the answer cluster (node in
  819%   the answer trie).  For answer subsumption it is a term Ret/ModeArgs
  820%   @arg Goal to Delays are extracted from the dependency/5 term in
  821%   the same order.
  822
  823%!  completion_step(+Worklist) is fail.
  824
  825completion_step(SourceWL) :-
  826    '$tbl_wkl_work'(SourceWL,
  827                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  828    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  829    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  830    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  831    tdebug(delay_goals(AllDelays, Cond)),
  832    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  833           [TargetGoal, SourceGoal, Answer, Cond]),
  834    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  835    fail.
  836
  837
  838		 /*******************************
  839		 *     STRATIFIED NEGATION	*
  840		 *******************************/
  841
  842%!  tnot(:Goal)
  843%
  844%   Tabled negation.
  845%
  846%   (*): Only variant tabling is allowed under tnot/1.
  847
  848tnot(Goal0) :-
  849    '$tnot_implementation'(Goal0, Goal),        % verifies Goal is tabled
  850    (   '$tbl_existing_variant_table'(_, Goal, Trie, Status, Skeleton),
  851        Status \== invalid
  852    ->  '$idg_add_edge'(Trie),
  853        (   '$tbl_answer_dl'(Trie, _, true)
  854        ->  fail
  855        ;   '$tbl_answer_dl'(Trie, _, _)
  856        ->  tdebug(tnot, 'tnot: adding ~p to delay list', [Goal]),
  857            add_delay(Trie)
  858        ;   Status == complete
  859        ->  true
  860        ;   negation_suspend(Goal, Skeleton, Status)
  861        )
  862    ;   tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  863        (   '$wrapped_implementation'(Goal, table, Implementation), % see (*)
  864            functor(Implementation, Closure, _),
  865            start_tabling(Closure, Goal, Implementation),
  866            fail
  867        ;   '$tbl_existing_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
  868            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  869            (   '$tbl_answer_dl'(Trie, _, true)
  870            ->  fail
  871            ;   '$tbl_answer_dl'(Trie, _, _)
  872            ->  add_delay(Trie)
  873            ;   NewStatus == complete
  874            ->  true
  875            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  876            )
  877        )
  878    ).
  879
  880floundering(Goal) :-
  881    format(string(Comment), 'Floundering goal in tnot/1: ~p', [Goal]),
  882    throw(error(instantiation_error, context(_Stack, Comment))).
  883
  884
  885%!  negation_suspend(+Goal, +Skeleton, +Worklist)
  886%
  887%   Suspend Worklist due to negation. This marks the worklist as dealing
  888%   with a negative literal and suspend.
  889%
  890%   The completion step will resume  negative   worklists  that  have no
  891%   solutions, causing this to succeed.
  892
  893negation_suspend(Wrapper, Skeleton, Worklist) :-
  894    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  895    '$tbl_wkl_negative'(Worklist),
  896    shift_for_copy(call_info(Skeleton, tnot(Worklist))),
  897    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  898    '$tbl_wkl_is_false'(Worklist).
  899
  900%!  not_exists(:P) is semidet.
  901%
  902%   Tabled negation for non-ground goals. This predicate uses the tabled
  903%   meta-predicate tabled_call/1. The tables  for xsb:tabled_call/1 must
  904%   be cleared if `the world changes' as   well  as to avoid aggregating
  905%   too many variants.
  906
  907not_exists(Goal) :-
  908    ground(Goal),
  909    '$get_predicate_attribute'(Goal, tabled, 1),
  910    !,
  911    tnot(Goal).
  912not_exists(Goal) :-
  913    (   tabled_call(Goal), fail
  914    ;   tnot(tabled_call(Goal))
  915    ).
  916
  917		 /*******************************
  918		 *           DELAY LISTS	*
  919		 *******************************/
  920
  921add_delay(Delay) :-
  922    '$tbl_delay_list'(DL0),
  923    '$tbl_set_delay_list'([Delay|DL0]).
  924
  925reset_delays :-
  926    '$tbl_set_delay_list'([]).
  927
  928%!  '$wfs_call'(:Goal, :Delays)
  929%
  930%   Call Goal and provide WFS delayed goals  as a conjunction in Delays.
  931%   This  predicate  is  the  internal  version  of  call_delays/2  from
  932%   library(wfs).
  933
  934'$wfs_call'(Goal, M:Delays) :-
  935    '$tbl_delay_list'(DL0),
  936    reset_delays,
  937    call(Goal),
  938    '$tbl_delay_list'(DL1),
  939    (   delay_goals(DL1, M, Delays)
  940    ->  true
  941    ;   Delays = undefined
  942    ),
  943    '$append'(DL0, DL1, DL),
  944    '$tbl_set_delay_list'(DL).
  945
  946delay_goals([], _, true) :-
  947    !.
  948delay_goals([AT+AN|T], M, Goal) :-
  949    !,
  950    (   integer(AN)
  951    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  952        (   '$tbl_is_trienode'(Moded)
  953        ->  trie_term(AN, Answer)
  954        ;   true                        % TBD: Generated moded answer
  955        )
  956    ;   AN = Skeleton/ModeArgs
  957    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  958        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  959        G0 = M1:G0plain
  960    ;   '$tbl_table_status'(AT, _, G0, AN)
  961    ),
  962    GN = G0,
  963    (   T == []
  964    ->  Goal = GN
  965    ;   Goal = (GN,GT),
  966        delay_goals(T, M, GT)
  967    ).
  968delay_goals([AT|T], M, Goal) :-
  969    atrie_goal(AT, G0),
  970    unqualify_goal(G0, M, G1),
  971    GN = tnot(G1),
  972    (   T == []
  973    ->  Goal = GN
  974    ;   Goal = (GN,GT),
  975        delay_goals(T, M, GT)
  976    ).
  977
  978at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
  979    is_trie(Trie),
  980    !,
  981    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
  982at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
  983    is_trie(Trie),
  984    !,
  985    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
  986    M2:'$table_mode'(Goal0, Variant, Moded),
  987    unqualify_goal(M2:Goal0, M, Goal).
  988
  989atrie_goal(Trie, M:Goal) :-
  990    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
  991    M:'$table_mode'(Goal, Variant, _Moded).
  992
  993unqualify_goal(M:Goal, M, Goal0) :-
  994    !,
  995    Goal0 = Goal.
  996unqualify_goal(Goal, _, Goal).
  997
  998
  999                 /*******************************
 1000                 *            CLEANUP           *
 1001                 *******************************/
 1002
 1003%!  abolish_all_tables
 1004%
 1005%   Remove all tables. This is normally  used   to  free up the space or
 1006%   recompute the result after predicates on   which the result for some
 1007%   tabled predicates depend.
 1008%
 1009%   Abolishes both local and shared   tables. Possibly incomplete tables
 1010%   are marked for destruction upon   completion.  The dependency graphs
 1011%   for incremental and monotonic tabling are reclaimed as well.
 1012
 1013abolish_all_tables :-
 1014    (   '$tbl_abolish_local_tables'
 1015    ->  true
 1016    ;   true
 1017    ),
 1018    (   '$tbl_variant_table'(VariantTrie),
 1019        trie_gen(VariantTrie, _, Trie),
 1020        '$tbl_destroy_table'(Trie),
 1021        fail
 1022    ;   true
 1023    ).
 1024
 1025abolish_private_tables :-
 1026    (   '$tbl_abolish_local_tables'
 1027    ->  true
 1028    ;   (   '$tbl_local_variant_table'(VariantTrie),
 1029            trie_gen(VariantTrie, _, Trie),
 1030            '$tbl_destroy_table'(Trie),
 1031            fail
 1032        ;   true
 1033        )
 1034    ).
 1035
 1036abolish_shared_tables :-
 1037    (   '$tbl_global_variant_table'(VariantTrie),
 1038        trie_gen(VariantTrie, _, Trie),
 1039        '$tbl_destroy_table'(Trie),
 1040        fail
 1041    ;   true
 1042    ).
 1043
 1044%!  abolish_table_subgoals(:Subgoal) is det.
 1045%
 1046%   Abolish all tables that unify with SubGoal.
 1047%
 1048%   @tbd: SubGoal must be callable.  Should we allow for more general
 1049%   patterns?
 1050
 1051abolish_table_subgoals(SubGoal0) :-
 1052    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1053    !,
 1054    '$must_be'(acyclic, SubGoal),
 1055    (   '$tbl_variant_table'(VariantTrie),
 1056        trie_gen(VariantTrie, M:SubGoal, Trie),
 1057        '$tbl_destroy_table'(Trie),
 1058        fail
 1059    ;   true
 1060    ).
 1061abolish_table_subgoals(_).
 1062
 1063%!  abolish_module_tables(+Module) is det.
 1064%
 1065%   Abolish all tables for predicates associated with the given module.
 1066
 1067abolish_module_tables(Module) :-
 1068    '$must_be'(atom, Module),
 1069    '$tbl_variant_table'(VariantTrie),
 1070    current_module(Module),
 1071    !,
 1072    forall(trie_gen(VariantTrie, Module:_, Trie),
 1073           '$tbl_destroy_table'(Trie)).
 1074abolish_module_tables(_).
 1075
 1076%!  abolish_nonincremental_tables is det.
 1077%
 1078%   Abolish all tables that are not related to incremental predicates.
 1079
 1080abolish_nonincremental_tables :-
 1081    (   '$tbl_variant_table'(VariantTrie),
 1082        trie_gen(VariantTrie, _, Trie),
 1083        '$tbl_table_status'(Trie, Status, Goal, _),
 1084        (   Status == complete
 1085        ->  true
 1086        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1087        ),
 1088        \+ predicate_property(Goal, incremental),
 1089        '$tbl_destroy_table'(Trie),
 1090        fail
 1091    ;   true
 1092    ).
 1093
 1094%!  abolish_nonincremental_tables(+Options)
 1095%
 1096%   Allow for skipping incomplete tables while abolishing.
 1097%
 1098%   @tbd Mark tables for destruction such   that they are abolished when
 1099%   completed.
 1100
 1101abolish_nonincremental_tables(Options) :-
 1102    (   Options = on_incomplete(Action)
 1103    ->  Action == skip
 1104    ;   '$option'(on_incomplete(skip), Options)
 1105    ),
 1106    !,
 1107    (   '$tbl_variant_table'(VariantTrie),
 1108        trie_gen(VariantTrie, _, Trie),
 1109        '$tbl_table_status'(Trie, complete, Goal, _),
 1110        \+ predicate_property(Goal, incremental),
 1111        '$tbl_destroy_table'(Trie),
 1112        fail
 1113    ;   true
 1114    ).
 1115abolish_nonincremental_tables(_) :-
 1116    abolish_nonincremental_tables.
 1117
 1118
 1119                 /*******************************
 1120                 *        EXAMINE TABLES        *
 1121                 *******************************/
 1122
 1123%!  current_table(:Variant, -Trie) is nondet.
 1124%
 1125%   True when Trie is the answer table   for  Variant. If Variant has an
 1126%   unbound module or goal, all  possible   answer  tries are generated,
 1127%   otherwise Variant is considered a fully instantiated variant and the
 1128%   predicate is semidet.
 1129
 1130current_table(Variant, Trie) :-
 1131    ct_generate(Variant),
 1132    !,
 1133    current_table_gen(Variant, Trie).
 1134current_table(Variant, Trie) :-
 1135    current_table_lookup(Variant, Trie),
 1136    !.
 1137
 1138current_table_gen(M:Variant, Trie) :-
 1139    '$tbl_local_variant_table'(VariantTrie),
 1140    trie_gen(VariantTrie, M:NonModed, Trie),
 1141    M:'$table_mode'(Variant, NonModed, _Moded).
 1142current_table_gen(M:Variant, Trie) :-
 1143    '$tbl_global_variant_table'(VariantTrie),
 1144    trie_gen(VariantTrie, M:NonModed, Trie),
 1145    \+ '$tbl_table_status'(Trie, fresh), % shared tables are not destroyed
 1146    M:'$table_mode'(Variant, NonModed, _Moded).
 1147
 1148current_table_lookup(M:Variant, Trie) :-
 1149    M:'$table_mode'(Variant, NonModed, _Moded),
 1150    '$tbl_local_variant_table'(VariantTrie),
 1151    trie_lookup(VariantTrie, M:NonModed, Trie).
 1152current_table_lookup(M:Variant, Trie) :-
 1153    M:'$table_mode'(Variant, NonModed, _Moded),
 1154    '$tbl_global_variant_table'(VariantTrie),
 1155    trie_lookup(VariantTrie, NonModed, Trie),
 1156    \+ '$tbl_table_status'(Trie, fresh).
 1157
 1158ct_generate(M:Variant) :-
 1159    (   var(Variant)
 1160    ->  true
 1161    ;   var(M)
 1162    ).
 1163
 1164                 /*******************************
 1165                 *      WRAPPER GENERATION      *
 1166                 *******************************/
 1167
 1168:- multifile
 1169    system:term_expansion/2,
 1170    tabled/2. 1171:- dynamic
 1172    system:term_expansion/2. 1173
 1174wrappers(Spec, M) -->
 1175    { tabling_defaults(
 1176          [ (table_incremental=true)            - (incremental=true),
 1177            (table_shared=true)                 - (tshared=true),
 1178            (table_subsumptive=true)            - ((mode)=subsumptive),
 1179            call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
 1180          ],
 1181          #{}, Defaults)
 1182    },
 1183    wrappers(Spec, M, Defaults).
 1184
 1185wrappers(Var, _, _) -->
 1186    { var(Var),
 1187      !,
 1188      '$instantiation_error'(Var)
 1189    }.
 1190wrappers(M:Spec, _, Opts) -->
 1191    !,
 1192    { '$must_be'(atom, M) },
 1193    wrappers(Spec, M, Opts).
 1194wrappers(Spec as Options, M, Opts0) -->
 1195    !,
 1196    { table_options(Options, Opts0, Opts) },
 1197    wrappers(Spec, M, Opts).
 1198wrappers((A,B), M, Opts) -->
 1199    !,
 1200    wrappers(A, M, Opts),
 1201    wrappers(B, M, Opts).
 1202wrappers(Name//Arity, M, Opts) -->
 1203    { atom(Name), integer(Arity), Arity >= 0,
 1204      !,
 1205      Arity1 is Arity+2
 1206    },
 1207    wrappers(Name/Arity1, M, Opts).
 1208wrappers(Name/Arity, Module, Opts) -->
 1209    { '$option'(mode(TMode), Opts, variant),
 1210      atom(Name), integer(Arity), Arity >= 0,
 1211      !,
 1212      functor(Head, Name, Arity),
 1213      '$tbl_trienode'(Reserved)
 1214    },
 1215    qualify(Module,
 1216            [ '$tabled'(Head, TMode),
 1217              '$table_mode'(Head, Head, Reserved)
 1218            ]),
 1219    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1220    ].
 1221wrappers(ModeDirectedSpec, Module, Opts) -->
 1222    { '$option'(mode(TMode), Opts, variant),
 1223      callable(ModeDirectedSpec),
 1224      !,
 1225      functor(ModeDirectedSpec, Name, Arity),
 1226      functor(Head, Name, Arity),
 1227      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1228      updater_clauses(Modes, Head, UpdateClauses),
 1229      mode_check(Moded, ModeTest),
 1230      (   ModeTest == true
 1231      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1232          TVariant = Head
 1233      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, Opts, ModeTest,
 1234                                            Module:Variant, Moded),
 1235          TVariant = Variant
 1236      )
 1237    },
 1238    qualify(Module,
 1239            [ '$tabled'(Head, TMode),
 1240              '$table_mode'(Head, TVariant, Moded)
 1241            ]),
 1242    [ (:- initialization(WrapClause, now))
 1243    ],
 1244    qualify(Module, UpdateClauses).
 1245wrappers(TableSpec, _M, _Opts) -->
 1246    { '$type_error'(table_desclaration, TableSpec)
 1247    }.
 1248
 1249qualify(Module, List) -->
 1250    { prolog_load_context(module, Module) },
 1251    !,
 1252    clist(List).
 1253qualify(Module, List) -->
 1254    qlist(List, Module).
 1255
 1256clist([])    --> [].
 1257clist([H|T]) --> [H], clist(T).
 1258
 1259qlist([], _)    --> [].
 1260qlist([H|T], M) --> [M:H], qlist(T, M).
 1261
 1262
 1263tabling_defaults([], Dict, Dict).
 1264tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
 1265    (   tabling_default(Condition)
 1266    ->  Dict1 = Dict0.put(Opt,Value)
 1267    ;   Dict1 = Dict0
 1268    ),
 1269    tabling_defaults(T, Dict1, Dict).
 1270
 1271tabling_default(Flag=FValue) :-
 1272    !,
 1273    current_prolog_flag(Flag, FValue).
 1274tabling_default(call(Term)) :-
 1275    call(Term).
 1276
 1277% Called from wrappers//2.
 1278
 1279subgoal_size_restraint(Level) :-
 1280    current_prolog_flag(max_table_subgoal_size_action, abstract),
 1281    current_prolog_flag(max_table_subgoal_size, Level).
 1282
 1283%!  table_options(+Options, +OptDictIn, -OptDictOut)
 1284%
 1285%   Handler the ... as _options_ ... construct.
 1286
 1287table_options(Options, _Opts0, _Opts) :-
 1288    var(Options),
 1289    '$instantiation_error'(Options).
 1290table_options((A,B), Opts0, Opts) :-
 1291    !,
 1292    table_options(A, Opts0, Opts1),
 1293    table_options(B, Opts1, Opts).
 1294table_options(subsumptive, Opts0, Opts1) :-
 1295    !,
 1296    put_dict(mode, Opts0, subsumptive, Opts1).
 1297table_options(variant, Opts0, Opts1) :-
 1298    !,
 1299    put_dict(mode, Opts0, variant, Opts1).
 1300table_options(incremental, Opts0, Opts1) :-
 1301    !,
 1302    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1303table_options(monotonic, Opts0, Opts1) :-
 1304    !,
 1305    put_dict(monotonic, Opts0, true, Opts1).
 1306table_options(opaque, Opts0, Opts1) :-
 1307    !,
 1308    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1309table_options(lazy, Opts0, Opts1) :-
 1310    !,
 1311    put_dict(lazy, Opts0, true, Opts1).
 1312table_options(dynamic, Opts0, Opts1) :-
 1313    !,
 1314    put_dict(dynamic, Opts0, true, Opts1).
 1315table_options(shared, Opts0, Opts1) :-
 1316    !,
 1317    put_dict(tshared, Opts0, true, Opts1).
 1318table_options(private, Opts0, Opts1) :-
 1319    !,
 1320    put_dict(tshared, Opts0, false, Opts1).
 1321table_options(max_answers(Count), Opts0, Opts1) :-
 1322    !,
 1323    restraint(max_answers, Count, Opts0, Opts1).
 1324table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1325    !,
 1326    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1327table_options(answer_abstract(Size), Opts0, Opts1) :-
 1328    !,
 1329    restraint(answer_abstract, Size, Opts0, Opts1).
 1330table_options(Opt, _, _) :-
 1331    '$domain_error'(table_option, Opt).
 1332
 1333restraint(Name, Value0, Opts0, Opts) :-
 1334    '$table_option'(Value0, Value),
 1335    (   Value < 0
 1336    ->  Opts = Opts0
 1337    ;   put_dict(Name, Opts0, Value, Opts)
 1338    ).
 1339
 1340
 1341%!  mode_check(+Moded, -TestCode)
 1342%
 1343%   Enforce the output arguments of a  mode-directed tabled predicate to
 1344%   be unbound.
 1345
 1346mode_check(Moded, Check) :-
 1347    var(Moded),
 1348    !,
 1349    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1350mode_check(Moded, true) :-
 1351    '$tbl_trienode'(Moded),
 1352    !.
 1353mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1354    Moded =.. [s|Vars],
 1355    var_check(Vars, Test).
 1356
 1357var_check([H|T], Test) :-
 1358    (   T == []
 1359    ->  Test = var(H)
 1360    ;   Test = (var(H),Rest),
 1361        var_check(T, Rest)
 1362    ).
 1363
 1364:- public
 1365    instantiated_moded_arg/1. 1366
 1367instantiated_moded_arg(Vars) :-
 1368    '$member'(V, Vars),
 1369    \+ var(V),
 1370    '$uninstantiation_error'(V).
 1371
 1372
 1373%!  extract_modes(+ModeSpec, +Head, -Variant, -Modes, -ModedAnswer) is det.
 1374%
 1375%   Split Head into  its  variant  and   term  that  matches  the  moded
 1376%   arguments.
 1377%
 1378%   @arg ModedAnswer is a term that  captures   that  value of all moded
 1379%   arguments of an answer. If there  is   only  one,  this is the value
 1380%   itself. If there are multiple, this is a term s(A1,A2,...)
 1381
 1382extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1383    compound(ModeSpec),
 1384    !,
 1385    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1386    compound_name_arguments(Head, Name, HeadArgs),
 1387    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1388    length(ModedArgs, Count),
 1389    atomic_list_concat([$,Name,$,Count], VName),
 1390    Variant =.. [VName|VariantArgs],
 1391    (   ModedArgs == []
 1392    ->  '$tbl_trienode'(ModedAnswer)
 1393    ;   ModedArgs = [ModedAnswer]
 1394    ->  true
 1395    ;   ModedAnswer =.. [s|ModedArgs]
 1396    ).
 1397extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1398    atomic_list_concat([$,Atom,$,0], Variant),
 1399    '$tbl_trienode'(ModedAnswer).
 1400
 1401%!  separate_args(+ModeSpecArgs, +HeadArgs,
 1402%!		  -NoModesArgs, -Modes, -ModeArgs) is det.
 1403%
 1404%   Split the arguments in those that  need   to  be part of the variant
 1405%   identity (NoModesArgs) and those that are aggregated (ModeArgs).
 1406%
 1407%   @arg Args seems a copy of ModeArgs, why?
 1408
 1409separate_args([], [], [], [], []).
 1410separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1411    indexed_mode(HM),
 1412    !,
 1413    separate_args(TM, TA, TNA, Modes, TMA).
 1414separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1415    separate_args(TM, TA, TNA, Modes, TMA).
 1416
 1417indexed_mode(Mode) :-                           % XSB
 1418    var(Mode),
 1419    !.
 1420indexed_mode(index).                            % YAP
 1421indexed_mode(+).                                % B
 1422
 1423%!  updater_clauses(+Modes, +Head, -Clauses)
 1424%
 1425%   Generates a clause to update the aggregated state.  Modes is
 1426%   a list of predicate names we apply to the state.
 1427
 1428updater_clauses([], _, []) :- !.
 1429updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1430    update_goal(P, S0,S1,S2, Body).
 1431updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1432    length(Modes, Len),
 1433    functor(S0, s, Len),
 1434    functor(S1, s, Len),
 1435    functor(S2, s, Len),
 1436    S0 =.. [_|Args0],
 1437    S1 =.. [_|Args1],
 1438    S2 =.. [_|Args2],
 1439    update_body(Modes, Args0, Args1, Args2, true, Body).
 1440
 1441update_body([], _, _, _, Body, Body).
 1442update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1443    update_goal(P, A0,A1,A2, Goal),
 1444    mkconj(Body0, Goal, Body1),
 1445    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1446
 1447update_goal(Var, _,_,_, _) :-
 1448    var(Var),
 1449    !,
 1450    '$instantiation_error'(Var).
 1451update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1452    !,
 1453    '$must_be'(atom, M),
 1454    update_goal(lattice(PI), S0,S1,S2, Goal).
 1455update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1456    !,
 1457    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1458    '$must_be'(atom, Name),
 1459    Goal =.. [Name,S0,S1,S2].
 1460update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1461    compound(Head),
 1462    !,
 1463    compound_name_arity(Head, Name, Arity),
 1464    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1465    Goal =.. [Name,S0,S1,S2].
 1466update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1467    !,
 1468    '$must_be'(atom, Name),
 1469    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1470update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1471    !,
 1472    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1473    '$must_be'(atom, Name),
 1474    Call =.. [Name, S0, S1],
 1475    Goal = (Call -> S2 = S0 ; S2 = S1).
 1476update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1477    !,
 1478    '$must_be'(atom, M),
 1479    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1480    '$must_be'(atom, Name),
 1481    Call =.. [Name, S0, S1],
 1482    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1483update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1484    !,
 1485    '$must_be'(atom, M),
 1486    '$must_be'(atom, Name),
 1487    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1488update_goal(po(Name), S0,S1,S2, Goal) :-
 1489    !,
 1490    '$must_be'(atom, Name),
 1491    update_goal(po(Name/2), S0,S1,S2, Goal).
 1492update_goal(Alias, S0,S1,S2, Goal) :-
 1493    update_alias(Alias, Update),
 1494    !,
 1495    update_goal(Update, S0,S1,S2, Goal).
 1496update_goal(Mode, _,_,_, _) :-
 1497    '$domain_error'(tabled_mode, Mode).
 1498
 1499update_alias(first, lattice('$tabling':first/3)).
 1500update_alias(-,     lattice('$tabling':first/3)).
 1501update_alias(last,  lattice('$tabling':last/3)).
 1502update_alias(min,   lattice('$tabling':min/3)).
 1503update_alias(max,   lattice('$tabling':max/3)).
 1504update_alias(sum,   lattice('$tabling':sum/3)).
 1505
 1506mkconj(true, G,  G) :- !.
 1507mkconj(G1,   G2, (G1,G2)).
 1508
 1509
 1510		 /*******************************
 1511		 *          AGGREGATION		*
 1512		 *******************************/
 1513
 1514%!  first(+S0, +S1, -S) is det.
 1515%!  last(+S0, +S1, -S) is det.
 1516%!  min(+S0, +S1, -S) is det.
 1517%!  max(+S0, +S1, -S) is det.
 1518%!  sum(+S0, +S1, -S) is det.
 1519%
 1520%   Implement YAP tabling modes.
 1521
 1522:- public first/3, last/3, min/3, max/3, sum/3. 1523
 1524first(S, _, S).
 1525last(_, S, S).
 1526min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1527max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1528sum(S0, S1, S) :- S is S0+S1.
 1529
 1530
 1531		 /*******************************
 1532		 *      DYNAMIC PREDICATES	*
 1533		 *******************************/
 1534
 1535%!  '$set_table_wrappers'(:Head)
 1536%
 1537%   Clear/add wrappers and notifications to trap dynamic predicates.
 1538%   This is required both for incremental and monotonic tabling.
 1539
 1540'$set_table_wrappers'(Pred) :-
 1541    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1542        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1543    ->  wrap_incremental(Pred)
 1544    ;   unwrap_incremental(Pred)
 1545    ),
 1546    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1547    ->  wrap_monotonic(Pred)
 1548    ;   unwrap_monotonic(Pred)
 1549    ).
 1550
 1551		 /*******************************
 1552		 *       MONOTONIC TABLING	*
 1553		 *******************************/
 1554
 1555%!  mon_assert_dep(+Dependency, +Continuation, +Skel, +ATrie) is det.
 1556%
 1557%   Create a dependency for monotonic tabling.   Skel  and ATrie are the
 1558%   target trie for solutions of Continuation.
 1559
 1560mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1561    '$idg_add_mono_dyn_dep'(Dynamic,
 1562                            dependency(Dynamic, Cont, Skel),
 1563                            ATrie).
 1564mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1565    '$idg_add_monotonic_dep'(SrcTrie,
 1566                             dependency(SrcSkel, IsMono, Cont, Skel),
 1567                             ATrie).
 1568
 1569%!  monotonic_affects(+SrcTrie, +SrcReturn, -IsMono,
 1570%!                    -Continuation, -Return, -Atrie)
 1571%
 1572%   Dependency between two monotonic tables. If   SrcReturn  is added to
 1573%   SrcTrie we must add all answers for Return of Continuation to Atrie.
 1574%   IsMono shares with Continuation and is   used  in start_tabling/3 to
 1575%   distinguish normal tabled call from propagation.
 1576
 1577monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1578    '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1579                              dependency(SrcSkel, IsMono, Cont, Skel)).
 1580
 1581%!  monotonic_dyn_affects(:Head, -Continuation, -Return, -ATrie)
 1582%
 1583%   Dynamic predicate that maintains  the   dependency  from a monotonic
 1584
 1585monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1586    dyn_affected(Head, DTrie),
 1587    '$idg_mono_affects_eager'(DTrie, ATrie,
 1588                              dependency(Head, Cont, Skel)).
 1589
 1590%!  wrap_monotonic(:Head)
 1591%
 1592%   Prepare the dynamic predicate Head for monotonic tabling. This traps
 1593%   calls to build the dependency graph and updates to propagate answers
 1594%   from new clauses through the dependency graph.
 1595
 1596wrap_monotonic(Head) :-
 1597    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1598                      '$start_monotonic'(Head, Wrapped)),
 1599    '$pi_head'(PI, Head),
 1600    prolog_listen(PI, monotonic_update).
 1601
 1602%!  unwrap_monotonic(+Head)
 1603%
 1604%   Remove the monotonic wrappers and dependencies.
 1605
 1606unwrap_monotonic(Head) :-
 1607    '$pi_head'(PI, Head),
 1608    (   unwrap_predicate(PI, monotonic)
 1609    ->  prolog_unlisten(PI, monotonic_update)
 1610    ;   true
 1611    ).
 1612
 1613%!  '$start_monotonic'(+Head, +Wrapped)
 1614%
 1615%   This is called the monotonic wrapper   around a dynamic predicate to
 1616%   collect the dependencies  between  the   dynamic  predicate  and the
 1617%   monotonic tabled predicates.
 1618
 1619'$start_monotonic'(Head, Wrapped) :-
 1620    (   '$tbl_collect_mono_dep'
 1621    ->  shift(dependency(Head)),
 1622        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1623        Wrapped,
 1624        tdebug(monotonic, '  --> ~p', [Head])
 1625    ;   Wrapped
 1626    ).
 1627
 1628%!  monotonic_update(+Action, +ClauseRef)
 1629%
 1630%   Trap changes to the monotonic dynamic predicate and forward them.
 1631
 1632:- public monotonic_update/2. 1633monotonic_update(Action, ClauseRef) :-
 1634    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1635    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1636        mon_propagate(Action, Head, ClauseRef)
 1637    ;   true
 1638    ).
 1639
 1640%!  mon_propagate(+Action, +Head, +ClauseRef)
 1641%
 1642%   Handle changes to a dynamic predicate as part of monotonic
 1643%   updates.
 1644
 1645mon_propagate(Action, Head, ClauseRef) :-
 1646    assert_action(Action),
 1647    !,
 1648    setup_call_cleanup(
 1649        '$tbl_propagate_start'(Old),
 1650        propagate_assert(Head),                 % eager monotonic dependencies
 1651        '$tbl_propagate_end'(Old)),
 1652    forall(dyn_affected(Head, ATrie),
 1653           '$mono_idg_changed'(ATrie, ClauseRef)). % lazy monotonic dependencies
 1654mon_propagate(retract, Head, _) :-
 1655    !,
 1656    mon_invalidate_dependents(Head).
 1657mon_propagate(rollback(Action), Head, _) :-
 1658    mon_propagate_rollback(Action, Head).
 1659
 1660mon_propagate_rollback(Action, _Head) :-
 1661    assert_action(Action),
 1662    !.
 1663mon_propagate_rollback(retract, Head) :-
 1664    mon_invalidate_dependents(Head).
 1665
 1666assert_action(asserta).
 1667assert_action(assertz).
 1668
 1669%!  propagate_assert(+Head) is det.
 1670%
 1671%   Propagate assertion of a dynamic clause with head Head.
 1672
 1673propagate_assert(Head) :-
 1674    tdebug(monotonic, 'Asserted ~p', [Head]),
 1675    (   monotonic_dyn_affects(Head, Cont, Skel, ATrie),
 1676        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1677        '$idg_set_current'(_, ATrie),
 1678        pdelim(Cont, Skel, ATrie),
 1679        fail
 1680    ;   true
 1681    ).
 1682
 1683%!  incr_propagate_assert(+Head) is det.
 1684%
 1685%   Propagate assertion of a dynamic clause with head Head, both
 1686%   through eager and dynamic tables.
 1687
 1688incr_propagate_assert(Head) :-
 1689    tdebug(monotonic, 'New dynamic answer ~p', [Head]),
 1690    (   dyn_affected(Head, DTrie),
 1691         '$idg_mono_affects'(DTrie, ATrie,
 1692                             dependency(Head, Cont, Skel)),
 1693        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1694        '$idg_set_current'(_, ATrie),
 1695        pdelim(Cont, Skel, ATrie),
 1696        fail
 1697    ;   true
 1698    ).
 1699
 1700
 1701%!  propagate_answer(+SrcTrie, +SrcSkel) is det.
 1702%
 1703%   Propagate the new answer SrcSkel to the answer table SrcTrie.
 1704
 1705propagate_answer(SrcTrie, SrcSkel) :-
 1706    (   monotonic_affects(SrcTrie, SrcSkel, true, Cont, Skel, ATrie),
 1707        tdebug(monotonic, 'Propagating tab ~p to ~p', [SrcTrie, ATrie]),
 1708        pdelim(Cont, Skel, ATrie),
 1709        fail
 1710    ;   true
 1711    ).
 1712
 1713%!  pdelim(+Worker, +Skel, +ATrie)
 1714%
 1715%   Call Worker (a continuation) and add   each  binding it provides for
 1716%   Skel  to  ATrie.  If  a  new  answer    is  added  to  ATrie,  using
 1717%   propagate_answer/2 to propagate this further. Note   that we may hit
 1718%   new dependencies and thus we need to run this using reset/3.
 1719%
 1720%   @tbd Not sure whether we need full   tabling  here. Need to think of
 1721%   test cases.
 1722
 1723pdelim(Worker, Skel, ATrie) :-
 1724    reset(Worker, Dep, Cont),
 1725    (   Cont == 0
 1726    ->  '$tbl_monotonic_add_answer'(ATrie, Skel),
 1727        propagate_answer(ATrie, Skel)
 1728    ;   mon_assert_dep(Dep, Cont, Skel, ATrie),
 1729        pdelim(Cont, Skel, ATrie)
 1730    ).
 1731
 1732%!  mon_invalidate_dependents(+Head)
 1733%
 1734%   A non-monotonic operation was done on Head. Invalidate all dependent
 1735%   tables, preparing for normal incremental   reevaluation  on the next
 1736%   cycle.
 1737
 1738mon_invalidate_dependents(Head) :-
 1739    tdebug(monotonic, 'Invalidate dependents for ~p', [Head]),
 1740    forall(dyn_affected(Head, ATrie),
 1741           '$idg_mono_invalidate'(ATrie)).
 1742
 1743%!  abolish_monotonic_tables
 1744%
 1745%   Abolish all monotonic tables and the monotonic dependency relations.
 1746%
 1747%   @tbd: just prepare for incremental reevaluation?
 1748
 1749abolish_monotonic_tables :-
 1750    (   '$tbl_variant_table'(VariantTrie),
 1751        trie_gen(VariantTrie, Goal, ATrie),
 1752        '$get_predicate_attribute'(Goal, monotonic, 1),
 1753        '$tbl_destroy_table'(ATrie),
 1754        fail
 1755    ;   true
 1756    ).
 1757
 1758		 /*******************************
 1759		 *      INCREMENTAL TABLING	*
 1760		 *******************************/
 1761
 1762%!  wrap_incremental(:Head) is det.
 1763%
 1764%   Wrap an incremental dynamic predicate to be added to the IDG.
 1765
 1766wrap_incremental(Head) :-
 1767    tdebug(monotonic, 'Wrapping ~p', [Head]),
 1768    abstract_goal(Head, Abstract),
 1769    '$pi_head'(PI, Head),
 1770    (   Head == Abstract
 1771    ->  prolog_listen(PI, dyn_update)
 1772    ;   prolog_listen(PI, dyn_update(Abstract))
 1773    ).
 1774
 1775abstract_goal(M:Head, M:Abstract) :-
 1776    compound(Head),
 1777    '$get_predicate_attribute'(M:Head, abstract, 1),
 1778    !,
 1779    compound_name_arity(Head, Name, Arity),
 1780    functor(Abstract, Name, Arity).
 1781abstract_goal(Head, Head).
 1782
 1783%!  dyn_update(+Action, +Context) is det.
 1784%
 1785%   Track changes to added or removed clauses. We use '$clause'/4
 1786%   because it works on erased clauses.
 1787%
 1788%   @tbd Add a '$clause_head'(-Head, +ClauseRef) to only decompile the
 1789%   head.
 1790
 1791:- public dyn_update/2, dyn_update/3. 1792
 1793dyn_update(_Action, ClauseRef) :-
 1794    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1795    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1796        dyn_changed_pattern(Head)
 1797    ;   true
 1798    ).
 1799
 1800dyn_update(Abstract, _, _) :-
 1801    dyn_changed_pattern(Abstract).
 1802
 1803dyn_changed_pattern(Term) :-
 1804    forall(dyn_affected(Term, ATrie),
 1805           '$idg_changed'(ATrie)).
 1806
 1807dyn_affected(Term, ATrie) :-
 1808    '$tbl_variant_table'(VTable),
 1809    trie_gen(VTable, Term, ATrie).
 1810
 1811%!  unwrap_incremental(:Head) is det.
 1812%
 1813%   Remove dynamic predicate incremenal forwarding,   reset the possible
 1814%   `abstract` property and remove possible tables.
 1815
 1816unwrap_incremental(Head) :-
 1817    '$pi_head'(PI, Head),
 1818    abstract_goal(Head, Abstract),
 1819    (   Head == Abstract
 1820    ->  prolog_unlisten(PI, dyn_update)
 1821    ;   '$set_predicate_attribute'(Head, abstract, 0),
 1822        prolog_unlisten(PI, dyn_update(_))
 1823    ),
 1824    (   '$tbl_variant_table'(VariantTrie)
 1825    ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1826               '$tbl_destroy_table'(ATrie))
 1827    ;   true
 1828    ).
 1829
 1830%!  reeval(+ATrie, :Goal, ?Return) is nondet.
 1831%
 1832%   Called  if  the   table   ATrie    is   out-of-date   (has  non-zero
 1833%   _falsecount_). The answers of this predicate are the answers to Goal
 1834%   after re-evaluating the answer trie.
 1835%
 1836%   This finds all dependency  paths  to   dynamic  predicates  and then
 1837%   evaluates the nodes in a breath-first  fashion starting at the level
 1838%   just above the dynamic predicates  and   moving  upwards.  Bottom up
 1839%   evaluation is used to profit from upward propagation of not-modified
 1840%   events that may cause the evaluation to stop early.
 1841%
 1842%   Note that false paths either end  in   a  dynamic node or a complete
 1843%   node. The latter happens if we have and  IDG   "D  -> P -> Q" and we
 1844%   first re-evaluate P for some reason.  Now   Q  can  still be invalid
 1845%   after P has been re-evaluated.
 1846%
 1847%   @arg ATrie is the answer trie.  When shared tabling, we own this
 1848%   trie.
 1849%   @arg Goal is tabled goal (variant).  If we run into a deadlock we
 1850%   need to call this.
 1851%   @arg Return is the return skeleton. We must run
 1852%   trie_gen_compiled(ATrie, Return) to enumerate the answers
 1853
 1854reeval(ATrie, Goal, Return) :-
 1855    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1856          retry_reeval(ATrie, Goal)).
 1857
 1858retry_reeval(ATrie, Goal) :-
 1859    '$tbl_reeval_abandon'(ATrie),
 1860    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1861    sleep(0.000001),
 1862    call(Goal).
 1863
 1864try_reeval(ATrie, Goal, Return) :-
 1865    nb_current('$tbl_reeval', true),
 1866    !,
 1867    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1868    do_reeval(ATrie, Goal, Return).
 1869try_reeval(ATrie, Goal, Return) :-
 1870    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1871    findall(Path, false_path(ATrie, Path), Paths0),
 1872    sort(0, @>, Paths0, Paths1),
 1873    clean_paths(Paths1, Paths),
 1874    tdebug(forall('$member'(Path, Paths),
 1875                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1876    reeval_paths(Paths, ATrie),
 1877    do_reeval(ATrie, Goal, Return).
 1878
 1879do_reeval(ATrie, Goal, Return) :-
 1880    '$tbl_reeval_prepare_top'(ATrie, Clause),
 1881    (   Clause == 0                          % complete and answer subsumption
 1882    ->  '$tbl_table_status'(ATrie, _Status, M:Variant, Return),
 1883        M:'$table_mode'(Goal0, Variant, ModeArgs),
 1884        Goal = M:Goal0,
 1885        moded_gen_answer(ATrie, Return, ModeArgs)
 1886    ;   nonvar(Clause)                       % complete
 1887    ->  trie_gen_compiled(Clause, Return)
 1888    ;   call(Goal)                           % actually re-evaluate
 1889    ).
 1890
 1891
 1892%!  clean_paths(+PathsIn, -Paths)
 1893%
 1894%   Clean the reevaluation paths. Get rid of   the head term for ranking
 1895%   and remove duplicate paths. Note that  a   Path  is a list of tries,
 1896%   ground terms.
 1897
 1898clean_paths([], []).
 1899clean_paths([[_|Path]|T0], [Path|T]) :-
 1900    clean_paths(T0, Path, T).
 1901
 1902clean_paths([], _, []).
 1903clean_paths([[_|CPath]|T0], CPath, T) :-
 1904    !,
 1905    clean_paths(T0, CPath, T).
 1906clean_paths([[_|Path]|T0], _, [Path|T]) :-
 1907    clean_paths(T0, Path, T).
 1908
 1909%!  reeval_paths(+Paths, +Atrie)
 1910%
 1911%   Make Atrie valid again by re-evaluating nodes   in Paths. We stop as
 1912%   soon as Atrie  is  valid  again.  Note   that  we  may  not  need to
 1913%   reevaluate all paths because evaluating the   head  of some path may
 1914%   include other nodes in an SCC, making them valid as well.
 1915
 1916reeval_paths([], _) :-
 1917    !.
 1918reeval_paths(BottomUp, ATrie) :-
 1919    is_invalid(ATrie),
 1920    !,
 1921    reeval_heads(BottomUp, ATrie, BottomUp1),
 1922    tdebug(assertion(BottomUp \== BottomUp1)),
 1923    '$list_to_set'(BottomUp1, BottomUp2),
 1924    reeval_paths(BottomUp2, ATrie).
 1925reeval_paths(_, _).
 1926
 1927reeval_heads(_, ATrie, []) :-                % target is valid again
 1928    \+ is_invalid(ATrie),
 1929    !.
 1930reeval_heads([], _, []).
 1931reeval_heads([[H]|B], ATrie, BT) :-          % Last one of a falsepath
 1932    reeval_node(H),
 1933    !,
 1934    reeval_heads(B, ATrie, BT).
 1935reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1936    reeval_node(H),
 1937    !,
 1938    reeval_heads(B, ATrie, BT).
 1939reeval_heads([FP|B], ATrie, [FP|BT]) :-
 1940    reeval_heads(B, ATrie, BT).
 1941
 1942
 1943%!  false_path(+Atrie, -Path) is nondet.
 1944%
 1945%   True when Path is a list of   invalid  tries (bottom up, ending with
 1946%   ATrie).   The   last   element   of    the     list    is   a   term
 1947%   `s(Rank,Length,ATrie)` that is used for sorting the paths.
 1948%
 1949%   If we find a table along the  way   that  is being worked on by some
 1950%   other thread we wait for it.
 1951
 1952false_path(ATrie, BottomUp) :-
 1953    false_path(ATrie, Path, []),
 1954    '$reverse'(Path, BottomUp).
 1955
 1956false_path(ATrie, [ATrie|T], Seen) :-
 1957    \+ memberchk(ATrie, Seen),
 1958    '$idg_false_edge'(ATrie, Dep, Status),
 1959    tdebug(reeval, '    ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
 1960    (   Status == invalid
 1961    ->  (   false_path(Dep, T, [ATrie|Seen])
 1962        ->  true
 1963        ;   length(Seen, Len),               % invalid has no dependencies:
 1964            T = [s(2, Len, [])]              % dynamic and tabled or explicitly
 1965        )                                    % invalidated
 1966    ;   status_rank(Status, Rank),
 1967        length(Seen, Len),
 1968        T = [s(Rank,Len,Dep)]
 1969    ).
 1970
 1971status_rank(dynamic,   2) :- !.
 1972status_rank(monotonic, 2) :- !.
 1973status_rank(complete,  1) :- !.
 1974status_rank(Status,    Rank) :-
 1975    var(Rank),
 1976    !,
 1977    format(user_error, 'Re-eval from status ~p~n', [Status]),
 1978    Rank = 0.
 1979status_rank(Rank,   Rank) :-
 1980    format(user_error, 'Re-eval from rank ~p~n', [Rank]).
 1981
 1982is_invalid(ATrie) :-
 1983    '$idg_falsecount'(ATrie, FalseCount),
 1984    FalseCount > 0.
 1985
 1986%!  reeval_node(+ATrie) is semidet.
 1987%
 1988%   Re-evaluate the invalid answer trie ATrie.  Initially this created a
 1989%   nested tabling environment, but this is dropped:
 1990%
 1991%     - It is possible for the re-evaluating variant to call into outer
 1992%       non/not-yet incremental tables, requiring a merge with this
 1993%       outer SCC.  This doesn't work well with a sub-environment.
 1994%     - We do not need one.  If this environment is not merged into the
 1995%       outer one it will complete before we continue.
 1996%
 1997%   Fails if the node is not ready for   evaluation. This is the case if
 1998%   it is valid or it is a lazy table that has invalid dependencies.
 1999
 2000reeval_node(ATrie) :-
 2001    '$tbl_reeval_prepare'(ATrie, M:Variant),
 2002    !,
 2003    M:'$table_mode'(Goal0, Variant, _Moded),
 2004    Goal = M:Goal0,
 2005    tdebug(reeval, 'Re-evaluating ~p', [Goal]),
 2006    (   '$idg_reset_current',
 2007        setup_call_cleanup(
 2008            nb_setval('$tbl_reeval', true),
 2009            ignore(Goal),                    % assumes local scheduling
 2010            nb_delete('$tbl_reeval')),
 2011        fail
 2012    ;   tdebug(reeval, 'Re-evaluated ~p', [Goal])
 2013    ).
 2014reeval_node(ATrie) :-
 2015    '$mono_reeval_prepare'(ATrie, Size),
 2016    !,
 2017    reeval_monotonic_node(ATrie, Size).
 2018reeval_node(ATrie) :-
 2019    \+ is_invalid(ATrie).
 2020
 2021reeval_monotonic_node(ATrie, Size) :-
 2022    setup_call_cleanup(
 2023        '$tbl_propagate_start'(Old),
 2024        reeval_monotonic_node(ATrie, Size, Deps),
 2025        '$tbl_propagate_end'(Old)),
 2026    (   Deps == []
 2027    ->  tdebug(reeval, 'Re-evaluation for ~p complete', [ATrie])
 2028    ;   Deps == false
 2029    ->  tdebug(reeval, 'Re-evaluation for ~p queued new answers', [ATrie]),
 2030        reeval_node(ATrie)
 2031    ;   tdebug(reeval, 'Re-evaluation for ~p: new invalid deps: ~p',
 2032               [ATrie, Deps]),
 2033        reeval_nodes(Deps),
 2034        reeval_node(ATrie)
 2035    ).
 2036
 2037%!  reeval_nodes(+Nodes:list(trie)) is det.
 2038%
 2039%   After pulling in the monotonic answers  into   some  node, this is a
 2040%   list if invalid dependencies.  We must revaluate these and then pull
 2041%   in possible queued answers before we are done.
 2042
 2043reeval_nodes([]).
 2044reeval_nodes([H|T]) :-
 2045    reeval_node(H),
 2046    reeval_nodes(T).
 2047
 2048reeval_monotonic_node(ATrie, Size, Deps) :-
 2049    tdebug(reeval, 'Re-evaluating lazy monotonic ~p', [ATrie]),
 2050    (   '$idg_mono_affects_lazy'(ATrie, _0SrcTrie, Dep, DepRef, Answers),
 2051        length(Answers, Count),
 2052        '$idg_mono_empty_queue'(DepRef, Count),
 2053        (   Dep = dependency(Head, Cont, Skel)
 2054        ->  (   '$member'(ClauseRef, Answers),
 2055                '$clause'(Head, _Body, ClauseRef, _Bindings),
 2056                tdebug(monotonic, 'Propagating ~p from ~p to ~p',
 2057                       [Head, _0SrcTrie, ATrie]),
 2058                '$idg_set_current'(_, ATrie),
 2059                pdelim(Cont, Skel, ATrie),
 2060                fail
 2061            ;   true
 2062            )
 2063        ;   Dep = dependency(SrcSkel, true, Cont, Skel)
 2064        ->  (   '$member'(Node, Answers),
 2065                '$tbl_node_answer'(Node, SrcSkel),
 2066                tdebug(monotonic, 'Propagating ~p from ~p to ~p',
 2067                       [Skel, _0SrcTrie, ATrie]),
 2068                '$idg_set_current'(_, ATrie),
 2069                pdelim(Cont, Skel, ATrie),
 2070                fail
 2071            ;   true
 2072            )
 2073        ;   tdebug(monotonic, 'Skipped queued ~p, answers ~p',
 2074                   [Dep, Answers])
 2075        ),
 2076        fail
 2077    ;   '$mono_reeval_done'(ATrie, Size, Deps)
 2078    ).
 2079
 2080
 2081		 /*******************************
 2082		 *      EXPAND DIRECTIVES	*
 2083		 *******************************/
 2084
 2085system:term_expansion((:- table(Preds)), Expansion) :-
 2086    \+ current_prolog_flag(xref, true),
 2087    prolog_load_context(module, M),
 2088    phrase(wrappers(Preds, M), Clauses),
 2089    multifile_decls(Clauses, Directives0),
 2090    sort(Directives0, Directives),
 2091    '$append'(Directives, Clauses, Expansion).
 2092
 2093multifile_decls([], []).
 2094multifile_decls([H0|T0], [H|T]) :-
 2095    multifile_decl(H0, H),
 2096    !,
 2097    multifile_decls(T0, T).
 2098multifile_decls([_|T0], T) :-
 2099    multifile_decls(T0, T).
 2100
 2101multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 2102    !,
 2103    functor(Head, Name, Arity).
 2104multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 2105    !,
 2106    functor(Head, Name, Arity).
 2107multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 2108    !,
 2109    functor(Head, Name, Arity).
 2110multifile_decl(Head, (:- multifile(Name/Arity))) :-
 2111    !,
 2112    Head \= (:-_),
 2113    functor(Head, Name, Arity).
 2114
 2115
 2116		 /*******************************
 2117		 *      ANSWER COMPLETION	*
 2118		 *******************************/
 2119
 2120:- public answer_completion/2. 2121
 2122%!  answer_completion(+AnswerTrie, +Return) is det.
 2123%
 2124%   Find  positive  loops  in  the  residual   program  and  remove  the
 2125%   corresponding answers, possibly causing   additional simplification.
 2126%   This is called from C  if   simplify_component()  detects  there are
 2127%   conditional answers after simplification.
 2128%
 2129%   Note that we are called recursively from   C.  Our caller prepared a
 2130%   clean new tabling environment and restores   the  old one after this
 2131%   predicate terminates.
 2132%
 2133%   @author This code is by David Warren as part of XSB.
 2134%   @see called from C, pl-tabling.c, answer_completion()
 2135
 2136answer_completion(AnswerTrie, Return) :-
 2137    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 2138    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 2139    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 2140                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 2141    (   Propagated > 0
 2142    ->  answer_completion(AnswerTrie, Return)
 2143    ;   true
 2144    ).
 2145
 2146answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 2147    (   eval_subgoal_in_residual(AnswerTrie, Return),
 2148        fail
 2149    ;   true
 2150    ),
 2151    delete_answers_for_failing_calls(Propagated),
 2152    (   Propagated == 0
 2153    ->  mark_succeeding_calls_as_answer_completed
 2154    ;   true
 2155    ).
 2156
 2157%!  delete_answers_for_failing_calls(-Propagated)
 2158%
 2159%   Delete answers whose condition  is  determined   to  be  `false` and
 2160%   return the number of additional  answers   that  changed status as a
 2161%   consequence of additional simplification propagation.
 2162
 2163delete_answers_for_failing_calls(Propagated) :-
 2164    State = state(0),
 2165    (   subgoal_residual_trie(ASGF, ESGF),
 2166        \+ trie_gen(ESGF, _ETmp),
 2167        tdebug(trie_goal(ASGF, Goal0, _)),
 2168        tdebug(trie_goal(ASGF, Goal, _0Return)),
 2169        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 2170        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 2171	'$tbl_force_truth_value'(ALeaf, false, Count),
 2172        arg(1, State, Prop0),
 2173        Prop is Prop0+Count-1,
 2174        nb_setarg(1, State, Prop),
 2175	fail
 2176    ;   arg(1, State, Propagated)
 2177    ).
 2178
 2179mark_succeeding_calls_as_answer_completed :-
 2180    (   subgoal_residual_trie(ASGF, _ESGF),
 2181        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 2182        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 2183            tdebug(trie_goal(ASGF, Goal, _0Return)),
 2184            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 2185            '$tbl_set_answer_completed'(ASGF)
 2186        ),
 2187        fail
 2188    ;   true
 2189    ).
 2190
 2191subgoal_residual_trie(ASGF, ESGF) :-
 2192    '$tbl_variant_table'(VariantTrie),
 2193    context_module(M),
 2194    trie_gen(VariantTrie, M:eval_subgoal_in_residual(ASGF, _), ESGF).
 2195
 2196%!  eval_dl_in_residual(+Condition)
 2197%
 2198%   Evaluate a condition by only looking at   the  residual goals of the
 2199%   involved calls.
 2200
 2201eval_dl_in_residual(true) :-
 2202    !.
 2203eval_dl_in_residual((A;B)) :-
 2204    !,
 2205    (   eval_dl_in_residual(A)
 2206    ;   eval_dl_in_residual(B)
 2207    ).
 2208eval_dl_in_residual((A,B)) :-
 2209    !,
 2210    eval_dl_in_residual(A),
 2211    eval_dl_in_residual(B).
 2212eval_dl_in_residual(tnot(G)) :-
 2213    !,
 2214    tdebug(ac, ' ? tnot(~p)', [G]),
 2215    current_table(G, SGF),
 2216    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2217    tnot(eval_subgoal_in_residual(SGF, Return)).
 2218eval_dl_in_residual(G) :-
 2219    tdebug(ac, ' ? ~p', [G]),
 2220    (   current_table(G, SGF)
 2221    ->	true
 2222    ;   more_general_table(G, SGF)
 2223    ->	true
 2224    ;	writeln(user_error, 'MISSING CALL? '(G)),
 2225        fail
 2226    ),
 2227    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2228    eval_subgoal_in_residual(SGF, Return).
 2229
 2230more_general_table(G, Trie) :-
 2231    term_variables(G, Vars),
 2232    '$tbl_variant_table'(VariantTrie),
 2233    trie_gen(VariantTrie, G, Trie),
 2234    is_most_general_term(Vars).
 2235
 2236:- table eval_subgoal_in_residual/2. 2237
 2238%!  eval_subgoal_in_residual(+AnswerTrie, ?Return)
 2239%
 2240%   Derive answers for the variant represented   by  AnswerTrie based on
 2241%   the residual goals only.
 2242
 2243eval_subgoal_in_residual(AnswerTrie, _Return) :-
 2244    '$tbl_is_answer_completed'(AnswerTrie),
 2245    !,
 2246    undefined.
 2247eval_subgoal_in_residual(AnswerTrie, Return) :-
 2248    '$tbl_answer'(AnswerTrie, Return, Condition),
 2249    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 2250    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 2251    eval_dl_in_residual(Condition).
 2252
 2253
 2254		 /*******************************
 2255		 *            TRIPWIRES		*
 2256		 *******************************/
 2257
 2258%!  tripwire(+Wire, +Action, +Context)
 2259%
 2260%   Called from the tabling engine of some  tripwire is exceeded and the
 2261%   situation  is  not  handled  internally   (such  as  `abstract`  and
 2262%   `bounded_rationality`.
 2263
 2264:- public tripwire/3. 2265:- multifile prolog:tripwire/2. 2266
 2267tripwire(Wire, _Action, Context) :-
 2268    prolog:tripwire(Wire, Context),
 2269    !.
 2270tripwire(Wire, Action, Context) :-
 2271    Error = error(resource_error(tripwire(Wire, Context)), _),
 2272    tripwire_action(Action, Error).
 2273
 2274tripwire_action(warning, Error) :-
 2275    print_message(warning, Error).
 2276tripwire_action(error, Error) :-
 2277    throw(Error).
 2278tripwire_action(suspend, Error) :-
 2279    print_message(warning, Error),
 2280    break.
 2281
 2282
 2283		 /*******************************
 2284		 *   SYSTEM TABLED PREDICATES	*
 2285		 *******************************/
 2286
 2287:- table
 2288    system:undefined/0,
 2289    system:answer_count_restraint/0,
 2290    system:radial_restraint/0,
 2291    system:tabled_call/1. 2292
 2293%!  undefined is undefined.
 2294%
 2295%   Expresses the value _bottom_ from the well founded semantics.
 2296
 2297system:(undefined :-
 2298    tnot(undefined)).
 2299
 2300%!  answer_count_restraint is undefined.
 2301%!  radial_restraint is undefined.
 2302%
 2303%   Similar  to  undefined/0,  providing  a   specific  _undefined_  for
 2304%   restraint violations.
 2305
 2306system:(answer_count_restraint :-
 2307    tnot(answer_count_restraint)).
 2308
 2309system:(radial_restraint :-
 2310    tnot(radial_restraint)).
 2311
 2312system:(tabled_call(X) :- call(X))