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 unconditional
  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
  748% both unconditional
  749update(0b11, Wrapper, M, Agg, New, Next, delete) :-
  750    !,
  751    M:'$table_update'(Wrapper, Agg, New, Next),
  752    Agg \=@= Next.
  753% old unconditional, new conditional
  754update(0b10, Wrapper, M, Agg, New, Next, keep) :-
  755    !,
  756    M:'$table_update'(Wrapper, Agg, New, Next0),
  757    (   Next0 =@= Agg
  758    ->  Next = Agg
  759    ;   Next = Next0
  760    ).
  761% old conditional, new unconditional,
  762update(0b01, Wrapper, M, Agg, New, Next, keep) :-
  763    !,
  764    M:'$table_update'(Wrapper, New, Agg, Next0),
  765    (   Next0 =@= Agg
  766    ->  Next = Agg
  767    ;   Next = Next0
  768    ).
  769% both conditional
  770update(0b00, _Wrapper, _M, _Agg, New, New, keep) :-
  771    !.
  772
  773%!  completion(+Component, -Status, -Clause) is det.
  774%
  775%   Wakeup suspended goals until no new answers are generated. Status is
  776%   one of `merged`, `completed` or `final`.  If Status is not `merged`,
  777%   Clause is a compiled  representation  for   the  answer  trie of the
  778%   Component leader.
  779
  780completion(SCC, Status, Clause) :-
  781    (   reset_delays,
  782        completion_(SCC),
  783        fail
  784    ;   '$tbl_table_complete_all'(SCC, Status, Clause),
  785        tdebug(schedule, 'SCC ~p: ~p', [scc(SCC), Status])
  786    ).
  787
  788completion_(SCC) :-
  789    repeat,
  790    (   '$tbl_pop_worklist'(SCC, WorkList)
  791    ->  tdebug(wl_goal(WorkList, Goal, _)),
  792        tdebug(schedule, 'Complete ~p in ~p', [Goal, scc(SCC)]),
  793        completion_step(WorkList)
  794    ;   !
  795    ).
  796
  797%!  '$tbl_wkl_work'(+WorkList,
  798%!                  -Answer,
  799%!                  -Continuation, -Wrapper, -TargetWorklist,
  800%!                  -Delays) is nondet.
  801%
  802%   True when Continuation needs to run with Answer and possible answers
  803%   need to be added to  TargetWorklist.   The  remaining  arguments are
  804%   there to restore variable bindings and restore the delay list.
  805%
  806%   The  suspension  added  by  '$tbl_wkl_add_suspension'/2  is  a  term
  807%   dependency(SrcWrapper,  Continuation,  Wrapper,  WorkList,  Delays).
  808%   Note that:
  809%
  810%     - Answer and Goal must be unified to rebind the _input_ arguments
  811%       for the continuation.
  812%     - Wrapper is stored in TargetWorklist on successful completion
  813%       of the Continuation.
  814%     - If Answer Subsumption is in effect, the story is a bit more
  815%       complex and ModeArgs provide the binding over which we do
  816%       _aggregation_. Otherwise, ModeArgs is the the
  817%       reserved trie node produced by '$tbl_trienode'/1.
  818%
  819%   @arg Answer is the answer term from the answer cluster (node in
  820%   the answer trie).  For answer subsumption it is a term Ret/ModeArgs
  821%   @arg Goal to Delays are extracted from the dependency/5 term in
  822%   the same order.
  823
  824%!  completion_step(+Worklist) is fail.
  825
  826completion_step(SourceWL) :-
  827    '$tbl_wkl_work'(SourceWL,
  828                    Answer, Continuation, TargetSkeleton, TargetWL, Delays),
  829    tdebug(wl_goal(SourceWL, SourceGoal, _)),
  830    tdebug(wl_goal(TargetWL, TargetGoal, _Skeleton)),
  831    tdebug('$tbl_add_global_delays'(Delays, AllDelays)),
  832    tdebug(delay_goals(AllDelays, Cond)),
  833    tdebug(schedule, 'Resuming ~p, calling ~p with ~p (delays = ~p)',
  834           [TargetGoal, SourceGoal, Answer, Cond]),
  835    delim(TargetSkeleton, Continuation, TargetWL, Delays),
  836    fail.
  837
  838
  839		 /*******************************
  840		 *     STRATIFIED NEGATION	*
  841		 *******************************/
  842
  843%!  tnot(:Goal)
  844%
  845%   Tabled negation.
  846%
  847%   (*): Only variant tabling is allowed under tnot/1.
  848
  849tnot(Goal0) :-
  850    '$tnot_implementation'(Goal0, Goal),        % verifies Goal is tabled
  851    (   '$tbl_existing_variant_table'(_, Goal, Trie, Status, Skeleton),
  852        Status \== invalid
  853    ->  '$idg_add_edge'(Trie),
  854        (   '$tbl_answer_dl'(Trie, _, true)
  855        ->  fail
  856        ;   '$tbl_answer_dl'(Trie, _, _)
  857        ->  tdebug(tnot, 'tnot: adding ~p to delay list', [Goal]),
  858            add_delay(Trie)
  859        ;   Status == complete
  860        ->  true
  861        ;   negation_suspend(Goal, Skeleton, Status)
  862        )
  863    ;   tdebug(tnot, 'tnot: ~p: fresh', [Goal]),
  864        (   '$wrapped_implementation'(Goal, table, Implementation), % see (*)
  865            functor(Implementation, Closure, _),
  866            start_tabling(Closure, Goal, Implementation),
  867            fail
  868        ;   '$tbl_existing_variant_table'(_, Goal, Trie, NewStatus, NewSkeleton),
  869            tdebug(tnot, 'tnot: fresh ~p now ~p', [Goal, NewStatus]),
  870            (   '$tbl_answer_dl'(Trie, _, true)
  871            ->  fail
  872            ;   '$tbl_answer_dl'(Trie, _, _)
  873            ->  add_delay(Trie)
  874            ;   NewStatus == complete
  875            ->  true
  876            ;   negation_suspend(Goal, NewSkeleton, NewStatus)
  877            )
  878        )
  879    ).
  880
  881floundering(Goal) :-
  882    format(string(Comment), 'Floundering goal in tnot/1: ~p', [Goal]),
  883    throw(error(instantiation_error, context(_Stack, Comment))).
  884
  885
  886%!  negation_suspend(+Goal, +Skeleton, +Worklist)
  887%
  888%   Suspend Worklist due to negation. This marks the worklist as dealing
  889%   with a negative literal and suspend.
  890%
  891%   The completion step will resume  negative   worklists  that  have no
  892%   solutions, causing this to succeed.
  893
  894negation_suspend(Wrapper, Skeleton, Worklist) :-
  895    tdebug(tnot, 'negation_suspend ~p (wl=~p)', [Wrapper, Worklist]),
  896    '$tbl_wkl_negative'(Worklist),
  897    shift_for_copy(call_info(Skeleton, tnot(Worklist))),
  898    tdebug(tnot, 'negation resume ~p (wl=~p)', [Wrapper, Worklist]),
  899    '$tbl_wkl_is_false'(Worklist).
  900
  901%!  not_exists(:P) is semidet.
  902%
  903%   Tabled negation for non-ground goals. This predicate uses the tabled
  904%   meta-predicate tabled_call/1. The tables  for xsb:tabled_call/1 must
  905%   be cleared if `the world changes' as   well  as to avoid aggregating
  906%   too many variants.
  907
  908not_exists(Goal) :-
  909    ground(Goal),
  910    '$get_predicate_attribute'(Goal, tabled, 1),
  911    !,
  912    tnot(Goal).
  913not_exists(Goal) :-
  914    (   tabled_call(Goal), fail
  915    ;   tnot(tabled_call(Goal))
  916    ).
  917
  918		 /*******************************
  919		 *           DELAY LISTS	*
  920		 *******************************/
  921
  922add_delay(Delay) :-
  923    '$tbl_delay_list'(DL0),
  924    '$tbl_set_delay_list'([Delay|DL0]).
  925
  926reset_delays :-
  927    '$tbl_set_delay_list'([]).
  928
  929%!  '$wfs_call'(:Goal, :Delays)
  930%
  931%   Call Goal and provide WFS delayed goals  as a conjunction in Delays.
  932%   This  predicate  is  the  internal  version  of  call_delays/2  from
  933%   library(wfs).
  934
  935'$wfs_call'(Goal, M:Delays) :-
  936    '$tbl_delay_list'(DL0),
  937    reset_delays,
  938    call(Goal),
  939    '$tbl_delay_list'(DL1),
  940    (   delay_goals(DL1, M, Delays)
  941    ->  true
  942    ;   Delays = undefined
  943    ),
  944    '$append'(DL0, DL1, DL),
  945    '$tbl_set_delay_list'(DL).
  946
  947delay_goals([], _, true) :-
  948    !.
  949delay_goals([AT+AN|T], M, Goal) :-
  950    !,
  951    (   integer(AN)
  952    ->  at_delay_goal(AT, M, G0, Answer, Moded),
  953        (   '$tbl_is_trienode'(Moded)
  954        ->  trie_term(AN, Answer)
  955        ;   true                        % TBD: Generated moded answer
  956        )
  957    ;   AN = Skeleton/ModeArgs
  958    ->  '$tbl_table_status'(AT, _, M1:GNoModes, Skeleton),
  959        M1:'$table_mode'(G0plain, GNoModes, ModeArgs),
  960        G0 = M1:G0plain
  961    ;   '$tbl_table_status'(AT, _, G0, AN)
  962    ),
  963    GN = G0,
  964    (   T == []
  965    ->  Goal = GN
  966    ;   Goal = (GN,GT),
  967        delay_goals(T, M, GT)
  968    ).
  969delay_goals([AT|T], M, Goal) :-
  970    atrie_goal(AT, G0),
  971    unqualify_goal(G0, M, G1),
  972    GN = tnot(G1),
  973    (   T == []
  974    ->  Goal = GN
  975    ;   Goal = (GN,GT),
  976        delay_goals(T, M, GT)
  977    ).
  978
  979at_delay_goal(tnot(Trie), M, tnot(Goal), Skeleton, Moded) :-
  980    is_trie(Trie),
  981    !,
  982    at_delay_goal(Trie, M, Goal, Skeleton, Moded).
  983at_delay_goal(Trie, M, Goal, Skeleton, Moded) :-
  984    is_trie(Trie),
  985    !,
  986    '$tbl_table_status'(Trie, _Status, M2:Variant, Skeleton),
  987    M2:'$table_mode'(Goal0, Variant, Moded),
  988    unqualify_goal(M2:Goal0, M, Goal).
  989
  990atrie_goal(Trie, M:Goal) :-
  991    '$tbl_table_status'(Trie, _Status, M:Variant, _Skeleton),
  992    M:'$table_mode'(Goal, Variant, _Moded).
  993
  994unqualify_goal(M:Goal, M, Goal0) :-
  995    !,
  996    Goal0 = Goal.
  997unqualify_goal(Goal, _, Goal).
  998
  999
 1000                 /*******************************
 1001                 *            CLEANUP           *
 1002                 *******************************/
 1003
 1004%!  abolish_all_tables
 1005%
 1006%   Remove all tables. This is normally  used   to  free up the space or
 1007%   recompute the result after predicates on   which the result for some
 1008%   tabled predicates depend.
 1009%
 1010%   Abolishes both local and shared   tables. Possibly incomplete tables
 1011%   are marked for destruction upon   completion.  The dependency graphs
 1012%   for incremental and monotonic tabling are reclaimed as well.
 1013
 1014abolish_all_tables :-
 1015    (   '$tbl_abolish_local_tables'
 1016    ->  true
 1017    ;   true
 1018    ),
 1019    (   '$tbl_variant_table'(VariantTrie),
 1020        trie_gen(VariantTrie, _, Trie),
 1021        '$tbl_destroy_table'(Trie),
 1022        fail
 1023    ;   true
 1024    ).
 1025
 1026abolish_private_tables :-
 1027    (   '$tbl_abolish_local_tables'
 1028    ->  true
 1029    ;   (   '$tbl_local_variant_table'(VariantTrie),
 1030            trie_gen(VariantTrie, _, Trie),
 1031            '$tbl_destroy_table'(Trie),
 1032            fail
 1033        ;   true
 1034        )
 1035    ).
 1036
 1037abolish_shared_tables :-
 1038    (   '$tbl_global_variant_table'(VariantTrie),
 1039        trie_gen(VariantTrie, _, Trie),
 1040        '$tbl_destroy_table'(Trie),
 1041        fail
 1042    ;   true
 1043    ).
 1044
 1045%!  abolish_table_subgoals(:Subgoal) is det.
 1046%
 1047%   Abolish all tables that unify with SubGoal.
 1048%
 1049%   @tbd: SubGoal must be callable.  Should we allow for more general
 1050%   patterns?
 1051
 1052abolish_table_subgoals(SubGoal0) :-
 1053    '$tbl_implementation'(SubGoal0, M:SubGoal),
 1054    !,
 1055    '$must_be'(acyclic, SubGoal),
 1056    (   '$tbl_variant_table'(VariantTrie),
 1057        trie_gen(VariantTrie, M:SubGoal, Trie),
 1058        '$tbl_destroy_table'(Trie),
 1059        fail
 1060    ;   true
 1061    ).
 1062abolish_table_subgoals(_).
 1063
 1064%!  abolish_module_tables(+Module) is det.
 1065%
 1066%   Abolish all tables for predicates associated with the given module.
 1067
 1068abolish_module_tables(Module) :-
 1069    '$must_be'(atom, Module),
 1070    '$tbl_variant_table'(VariantTrie),
 1071    current_module(Module),
 1072    !,
 1073    forall(trie_gen(VariantTrie, Module:_, Trie),
 1074           '$tbl_destroy_table'(Trie)).
 1075abolish_module_tables(_).
 1076
 1077%!  abolish_nonincremental_tables is det.
 1078%
 1079%   Abolish all tables that are not related to incremental predicates.
 1080
 1081abolish_nonincremental_tables :-
 1082    (   '$tbl_variant_table'(VariantTrie),
 1083        trie_gen(VariantTrie, _, Trie),
 1084        '$tbl_table_status'(Trie, Status, Goal, _),
 1085        (   Status == complete
 1086        ->  true
 1087        ;   '$permission_error'(abolish, incomplete_table, Trie)
 1088        ),
 1089        \+ predicate_property(Goal, incremental),
 1090        '$tbl_destroy_table'(Trie),
 1091        fail
 1092    ;   true
 1093    ).
 1094
 1095%!  abolish_nonincremental_tables(+Options)
 1096%
 1097%   Allow for skipping incomplete tables while abolishing.
 1098%
 1099%   @tbd Mark tables for destruction such   that they are abolished when
 1100%   completed.
 1101
 1102abolish_nonincremental_tables(Options) :-
 1103    (   Options = on_incomplete(Action)
 1104    ->  Action == skip
 1105    ;   '$option'(on_incomplete(skip), Options)
 1106    ),
 1107    !,
 1108    (   '$tbl_variant_table'(VariantTrie),
 1109        trie_gen(VariantTrie, _, Trie),
 1110        '$tbl_table_status'(Trie, complete, Goal, _),
 1111        \+ predicate_property(Goal, incremental),
 1112        '$tbl_destroy_table'(Trie),
 1113        fail
 1114    ;   true
 1115    ).
 1116abolish_nonincremental_tables(_) :-
 1117    abolish_nonincremental_tables.
 1118
 1119
 1120                 /*******************************
 1121                 *        EXAMINE TABLES        *
 1122                 *******************************/
 1123
 1124%!  current_table(:Variant, -Trie) is nondet.
 1125%
 1126%   True when Trie is the answer table   for  Variant. If Variant has an
 1127%   unbound module or goal, all  possible   answer  tries are generated,
 1128%   otherwise Variant is considered a fully instantiated variant and the
 1129%   predicate is semidet.
 1130
 1131current_table(Variant, Trie) :-
 1132    ct_generate(Variant),
 1133    !,
 1134    current_table_gen(Variant, Trie).
 1135current_table(Variant, Trie) :-
 1136    current_table_lookup(Variant, Trie),
 1137    !.
 1138
 1139current_table_gen(M:Variant, Trie) :-
 1140    '$tbl_local_variant_table'(VariantTrie),
 1141    trie_gen(VariantTrie, M:NonModed, Trie),
 1142    M:'$table_mode'(Variant, NonModed, _Moded).
 1143current_table_gen(M:Variant, Trie) :-
 1144    '$tbl_global_variant_table'(VariantTrie),
 1145    trie_gen(VariantTrie, M:NonModed, Trie),
 1146    \+ '$tbl_table_status'(Trie, fresh), % shared tables are not destroyed
 1147    M:'$table_mode'(Variant, NonModed, _Moded).
 1148
 1149current_table_lookup(M:Variant, Trie) :-
 1150    M:'$table_mode'(Variant, NonModed, _Moded),
 1151    '$tbl_local_variant_table'(VariantTrie),
 1152    trie_lookup(VariantTrie, M:NonModed, Trie).
 1153current_table_lookup(M:Variant, Trie) :-
 1154    M:'$table_mode'(Variant, NonModed, _Moded),
 1155    '$tbl_global_variant_table'(VariantTrie),
 1156    trie_lookup(VariantTrie, NonModed, Trie),
 1157    \+ '$tbl_table_status'(Trie, fresh).
 1158
 1159ct_generate(M:Variant) :-
 1160    (   var(Variant)
 1161    ->  true
 1162    ;   var(M)
 1163    ).
 1164
 1165                 /*******************************
 1166                 *      WRAPPER GENERATION      *
 1167                 *******************************/
 1168
 1169:- multifile
 1170    system:term_expansion/2,
 1171    tabled/2. 1172:- dynamic
 1173    system:term_expansion/2. 1174
 1175wrappers(Spec, M) -->
 1176    { tabling_defaults(
 1177          [ (table_incremental=true)            - (incremental=true),
 1178            (table_shared=true)                 - (tshared=true),
 1179            (table_subsumptive=true)            - ((mode)=subsumptive),
 1180            call(subgoal_size_restraint(Level)) - (subgoal_abstract=Level)
 1181          ],
 1182          #{}, Defaults)
 1183    },
 1184    wrappers(Spec, M, Defaults).
 1185
 1186wrappers(Var, _, _) -->
 1187    { var(Var),
 1188      !,
 1189      '$instantiation_error'(Var)
 1190    }.
 1191wrappers(M:Spec, _, Opts) -->
 1192    !,
 1193    { '$must_be'(atom, M) },
 1194    wrappers(Spec, M, Opts).
 1195wrappers(Spec as Options, M, Opts0) -->
 1196    !,
 1197    { table_options(Options, Opts0, Opts) },
 1198    wrappers(Spec, M, Opts).
 1199wrappers((A,B), M, Opts) -->
 1200    !,
 1201    wrappers(A, M, Opts),
 1202    wrappers(B, M, Opts).
 1203wrappers(Name//Arity, M, Opts) -->
 1204    { atom(Name), integer(Arity), Arity >= 0,
 1205      !,
 1206      Arity1 is Arity+2
 1207    },
 1208    wrappers(Name/Arity1, M, Opts).
 1209wrappers(Name/Arity, Module, Opts) -->
 1210    { '$option'(mode(TMode), Opts, variant),
 1211      atom(Name), integer(Arity), Arity >= 0,
 1212      !,
 1213      functor(Head, Name, Arity),
 1214      '$tbl_trienode'(Reserved)
 1215    },
 1216    qualify(Module,
 1217            [ '$tabled'(Head, TMode),
 1218              '$table_mode'(Head, Head, Reserved)
 1219            ]),
 1220    [ (:- initialization('$wrap_tabled'(Module:Head, Opts), now))
 1221    ].
 1222wrappers(ModeDirectedSpec, Module, Opts) -->
 1223    { '$option'(mode(TMode), Opts, variant),
 1224      callable(ModeDirectedSpec),
 1225      !,
 1226      functor(ModeDirectedSpec, Name, Arity),
 1227      functor(Head, Name, Arity),
 1228      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
 1229      updater_clauses(Modes, Head, UpdateClauses),
 1230      mode_check(Moded, ModeTest),
 1231      (   ModeTest == true
 1232      ->  WrapClause = '$wrap_tabled'(Module:Head, Opts),
 1233          TVariant = Head
 1234      ;   WrapClause = '$moded_wrap_tabled'(Module:Head, Opts, ModeTest,
 1235                                            Module:Variant, Moded),
 1236          TVariant = Variant
 1237      )
 1238    },
 1239    qualify(Module,
 1240            [ '$tabled'(Head, TMode),
 1241              '$table_mode'(Head, TVariant, Moded)
 1242            ]),
 1243    [ (:- initialization(WrapClause, now))
 1244    ],
 1245    qualify(Module, UpdateClauses).
 1246wrappers(TableSpec, _M, _Opts) -->
 1247    { '$type_error'(table_desclaration, TableSpec)
 1248    }.
 1249
 1250qualify(Module, List) -->
 1251    { prolog_load_context(module, Module) },
 1252    !,
 1253    clist(List).
 1254qualify(Module, List) -->
 1255    qlist(List, Module).
 1256
 1257clist([])    --> [].
 1258clist([H|T]) --> [H], clist(T).
 1259
 1260qlist([], _)    --> [].
 1261qlist([H|T], M) --> [M:H], qlist(T, M).
 1262
 1263
 1264tabling_defaults([], Dict, Dict).
 1265tabling_defaults([Condition-(Opt=Value)|T], Dict0, Dict) :-
 1266    (   tabling_default(Condition)
 1267    ->  Dict1 = Dict0.put(Opt,Value)
 1268    ;   Dict1 = Dict0
 1269    ),
 1270    tabling_defaults(T, Dict1, Dict).
 1271
 1272tabling_default(Flag=FValue) :-
 1273    !,
 1274    current_prolog_flag(Flag, FValue).
 1275tabling_default(call(Term)) :-
 1276    call(Term).
 1277
 1278% Called from wrappers//2.
 1279
 1280subgoal_size_restraint(Level) :-
 1281    current_prolog_flag(max_table_subgoal_size_action, abstract),
 1282    current_prolog_flag(max_table_subgoal_size, Level).
 1283
 1284%!  table_options(+Options, +OptDictIn, -OptDictOut)
 1285%
 1286%   Handler the ... as _options_ ... construct.
 1287
 1288table_options(Options, _Opts0, _Opts) :-
 1289    var(Options),
 1290    '$instantiation_error'(Options).
 1291table_options((A,B), Opts0, Opts) :-
 1292    !,
 1293    table_options(A, Opts0, Opts1),
 1294    table_options(B, Opts1, Opts).
 1295table_options(subsumptive, Opts0, Opts1) :-
 1296    !,
 1297    put_dict(mode, Opts0, subsumptive, Opts1).
 1298table_options(variant, Opts0, Opts1) :-
 1299    !,
 1300    put_dict(mode, Opts0, variant, Opts1).
 1301table_options(incremental, Opts0, Opts1) :-
 1302    !,
 1303    put_dict(#{incremental:true,opaque:false}, Opts0, Opts1).
 1304table_options(monotonic, Opts0, Opts1) :-
 1305    !,
 1306    put_dict(monotonic, Opts0, true, Opts1).
 1307table_options(opaque, Opts0, Opts1) :-
 1308    !,
 1309    put_dict(#{incremental:false,opaque:true}, Opts0, Opts1).
 1310table_options(lazy, Opts0, Opts1) :-
 1311    !,
 1312    put_dict(lazy, Opts0, true, Opts1).
 1313table_options(dynamic, Opts0, Opts1) :-
 1314    !,
 1315    put_dict(dynamic, Opts0, true, Opts1).
 1316table_options(shared, Opts0, Opts1) :-
 1317    !,
 1318    put_dict(tshared, Opts0, true, Opts1).
 1319table_options(private, Opts0, Opts1) :-
 1320    !,
 1321    put_dict(tshared, Opts0, false, Opts1).
 1322table_options(max_answers(Count), Opts0, Opts1) :-
 1323    !,
 1324    restraint(max_answers, Count, Opts0, Opts1).
 1325table_options(subgoal_abstract(Size), Opts0, Opts1) :-
 1326    !,
 1327    restraint(subgoal_abstract, Size, Opts0, Opts1).
 1328table_options(answer_abstract(Size), Opts0, Opts1) :-
 1329    !,
 1330    restraint(answer_abstract, Size, Opts0, Opts1).
 1331table_options(Opt, _, _) :-
 1332    '$domain_error'(table_option, Opt).
 1333
 1334restraint(Name, Value0, Opts0, Opts) :-
 1335    '$table_option'(Value0, Value),
 1336    (   Value < 0
 1337    ->  Opts = Opts0
 1338    ;   put_dict(Name, Opts0, Value, Opts)
 1339    ).
 1340
 1341
 1342%!  mode_check(+Moded, -TestCode)
 1343%
 1344%   Enforce the output arguments of a  mode-directed tabled predicate to
 1345%   be unbound.
 1346
 1347mode_check(Moded, Check) :-
 1348    var(Moded),
 1349    !,
 1350    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
 1351mode_check(Moded, true) :-
 1352    '$tbl_trienode'(Moded),
 1353    !.
 1354mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
 1355    Moded =.. [s|Vars],
 1356    var_check(Vars, Test).
 1357
 1358var_check([H|T], Test) :-
 1359    (   T == []
 1360    ->  Test = var(H)
 1361    ;   Test = (var(H),Rest),
 1362        var_check(T, Rest)
 1363    ).
 1364
 1365:- public
 1366    instantiated_moded_arg/1. 1367
 1368instantiated_moded_arg(Vars) :-
 1369    '$member'(V, Vars),
 1370    \+ var(V),
 1371    '$uninstantiation_error'(V).
 1372
 1373
 1374%!  extract_modes(+ModeSpec, +Head, -Variant, -Modes, -ModedAnswer) is det.
 1375%
 1376%   Split Head into  its  variant  and   term  that  matches  the  moded
 1377%   arguments.
 1378%
 1379%   @arg ModedAnswer is a term that  captures   that  value of all moded
 1380%   arguments of an answer. If there  is   only  one,  this is the value
 1381%   itself. If there are multiple, this is a term s(A1,A2,...)
 1382
 1383extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
 1384    compound(ModeSpec),
 1385    !,
 1386    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
 1387    compound_name_arguments(Head, Name, HeadArgs),
 1388    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
 1389    length(ModedArgs, Count),
 1390    atomic_list_concat([$,Name,$,Count], VName),
 1391    Variant =.. [VName|VariantArgs],
 1392    (   ModedArgs == []
 1393    ->  '$tbl_trienode'(ModedAnswer)
 1394    ;   ModedArgs = [ModedAnswer]
 1395    ->  true
 1396    ;   ModedAnswer =.. [s|ModedArgs]
 1397    ).
 1398extract_modes(Atom, Atom, Variant, [], ModedAnswer) :-
 1399    atomic_list_concat([$,Atom,$,0], Variant),
 1400    '$tbl_trienode'(ModedAnswer).
 1401
 1402%!  separate_args(+ModeSpecArgs, +HeadArgs,
 1403%!		  -NoModesArgs, -Modes, -ModeArgs) is det.
 1404%
 1405%   Split the arguments in those that  need   to  be part of the variant
 1406%   identity (NoModesArgs) and those that are aggregated (ModeArgs).
 1407%
 1408%   @arg Args seems a copy of ModeArgs, why?
 1409
 1410separate_args([], [], [], [], []).
 1411separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
 1412    indexed_mode(HM),
 1413    !,
 1414    separate_args(TM, TA, TNA, Modes, TMA).
 1415separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
 1416    separate_args(TM, TA, TNA, Modes, TMA).
 1417
 1418indexed_mode(Mode) :-                           % XSB
 1419    var(Mode),
 1420    !.
 1421indexed_mode(index).                            % YAP
 1422indexed_mode(+).                                % B
 1423
 1424%!  updater_clauses(+Modes, +Head, -Clauses)
 1425%
 1426%   Generates a clause to update the aggregated state.  Modes is
 1427%   a list of predicate names we apply to the state.
 1428
 1429updater_clauses([], _, []) :- !.
 1430updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
 1431    update_goal(P, S0,S1,S2, Body).
 1432updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
 1433    length(Modes, Len),
 1434    functor(S0, s, Len),
 1435    functor(S1, s, Len),
 1436    functor(S2, s, Len),
 1437    S0 =.. [_|Args0],
 1438    S1 =.. [_|Args1],
 1439    S2 =.. [_|Args2],
 1440    update_body(Modes, Args0, Args1, Args2, true, Body).
 1441
 1442update_body([], _, _, _, Body, Body).
 1443update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
 1444    update_goal(P, A0,A1,A2, Goal),
 1445    mkconj(Body0, Goal, Body1),
 1446    update_body(TM, Args0, Args1, Args2, Body1, Body).
 1447
 1448update_goal(Var, _,_,_, _) :-
 1449    var(Var),
 1450    !,
 1451    '$instantiation_error'(Var).
 1452update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
 1453    !,
 1454    '$must_be'(atom, M),
 1455    update_goal(lattice(PI), S0,S1,S2, Goal).
 1456update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
 1457    !,
 1458    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1459    '$must_be'(atom, Name),
 1460    Goal =.. [Name,S0,S1,S2].
 1461update_goal(lattice(Head), S0,S1,S2, Goal) :-
 1462    compound(Head),
 1463    !,
 1464    compound_name_arity(Head, Name, Arity),
 1465    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
 1466    Goal =.. [Name,S0,S1,S2].
 1467update_goal(lattice(Name), S0,S1,S2, Goal) :-
 1468    !,
 1469    '$must_be'(atom, Name),
 1470    update_goal(lattice(Name/3), S0,S1,S2, Goal).
 1471update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
 1472    !,
 1473    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1474    '$must_be'(atom, Name),
 1475    Call =.. [Name, S0, S1],
 1476    Goal = (Call -> S2 = S0 ; S2 = S1).
 1477update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
 1478    !,
 1479    '$must_be'(atom, M),
 1480    '$must_be'(oneof(integer, po_arity, [2]), Arity),
 1481    '$must_be'(atom, Name),
 1482    Call =.. [Name, S0, S1],
 1483    Goal = (M:Call -> S2 = S0 ; S2 = S1).
 1484update_goal(po(M:Name), S0,S1,S2, Goal) :-
 1485    !,
 1486    '$must_be'(atom, M),
 1487    '$must_be'(atom, Name),
 1488    update_goal(po(M:Name/2), S0,S1,S2, Goal).
 1489update_goal(po(Name), S0,S1,S2, Goal) :-
 1490    !,
 1491    '$must_be'(atom, Name),
 1492    update_goal(po(Name/2), S0,S1,S2, Goal).
 1493update_goal(Alias, S0,S1,S2, Goal) :-
 1494    update_alias(Alias, Update),
 1495    !,
 1496    update_goal(Update, S0,S1,S2, Goal).
 1497update_goal(Mode, _,_,_, _) :-
 1498    '$domain_error'(tabled_mode, Mode).
 1499
 1500update_alias(first, lattice('$tabling':first/3)).
 1501update_alias(-,     lattice('$tabling':first/3)).
 1502update_alias(last,  lattice('$tabling':last/3)).
 1503update_alias(min,   lattice('$tabling':min/3)).
 1504update_alias(max,   lattice('$tabling':max/3)).
 1505update_alias(sum,   lattice('$tabling':sum/3)).
 1506
 1507mkconj(true, G,  G) :- !.
 1508mkconj(G1,   G2, (G1,G2)).
 1509
 1510
 1511		 /*******************************
 1512		 *          AGGREGATION		*
 1513		 *******************************/
 1514
 1515%!  first(+S0, +S1, -S) is det.
 1516%!  last(+S0, +S1, -S) is det.
 1517%!  min(+S0, +S1, -S) is det.
 1518%!  max(+S0, +S1, -S) is det.
 1519%!  sum(+S0, +S1, -S) is det.
 1520%
 1521%   Implement YAP tabling modes.
 1522
 1523:- public first/3, last/3, min/3, max/3, sum/3. 1524
 1525first(S, _, S).
 1526last(_, S, S).
 1527min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
 1528max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
 1529sum(S0, S1, S) :- S is S0+S1.
 1530
 1531
 1532		 /*******************************
 1533		 *      DYNAMIC PREDICATES	*
 1534		 *******************************/
 1535
 1536%!  '$set_table_wrappers'(:Head)
 1537%
 1538%   Clear/add wrappers and notifications to trap dynamic predicates.
 1539%   This is required both for incremental and monotonic tabling.
 1540
 1541'$set_table_wrappers'(Pred) :-
 1542    (   '$get_predicate_attribute'(Pred, incremental, 1),
 1543        \+ '$get_predicate_attribute'(Pred, opaque, 1)
 1544    ->  wrap_incremental(Pred)
 1545    ;   unwrap_incremental(Pred)
 1546    ),
 1547    (   '$get_predicate_attribute'(Pred, monotonic, 1)
 1548    ->  wrap_monotonic(Pred)
 1549    ;   unwrap_monotonic(Pred)
 1550    ).
 1551
 1552		 /*******************************
 1553		 *       MONOTONIC TABLING	*
 1554		 *******************************/
 1555
 1556%!  mon_assert_dep(+Dependency, +Continuation, +Skel, +ATrie) is det.
 1557%
 1558%   Create a dependency for monotonic tabling.   Skel  and ATrie are the
 1559%   target trie for solutions of Continuation.
 1560
 1561mon_assert_dep(dependency(Dynamic), Cont, Skel, ATrie) :-
 1562    '$idg_add_mono_dyn_dep'(Dynamic,
 1563                            dependency(Dynamic, Cont, Skel),
 1564                            ATrie).
 1565mon_assert_dep(dependency(SrcSkel, SrcTrie, IsMono), Cont, Skel, ATrie) :-
 1566    '$idg_add_monotonic_dep'(SrcTrie,
 1567                             dependency(SrcSkel, IsMono, Cont, Skel),
 1568                             ATrie).
 1569
 1570%!  monotonic_affects(+SrcTrie, +SrcReturn, -IsMono,
 1571%!                    -Continuation, -Return, -Atrie)
 1572%
 1573%   Dependency between two monotonic tables. If   SrcReturn  is added to
 1574%   SrcTrie we must add all answers for Return of Continuation to Atrie.
 1575%   IsMono shares with Continuation and is   used  in start_tabling/3 to
 1576%   distinguish normal tabled call from propagation.
 1577
 1578monotonic_affects(SrcTrie, SrcSkel, IsMono, Cont, Skel, ATrie) :-
 1579    '$idg_mono_affects_eager'(SrcTrie, ATrie,
 1580                              dependency(SrcSkel, IsMono, Cont, Skel)).
 1581
 1582%!  monotonic_dyn_affects(:Head, -Continuation, -Return, -ATrie)
 1583%
 1584%   Dynamic predicate that maintains  the   dependency  from a monotonic
 1585
 1586monotonic_dyn_affects(Head, Cont, Skel, ATrie) :-
 1587    dyn_affected(Head, DTrie),
 1588    '$idg_mono_affects_eager'(DTrie, ATrie,
 1589                              dependency(Head, Cont, Skel)).
 1590
 1591%!  wrap_monotonic(:Head)
 1592%
 1593%   Prepare the dynamic predicate Head for monotonic tabling. This traps
 1594%   calls to build the dependency graph and updates to propagate answers
 1595%   from new clauses through the dependency graph.
 1596
 1597wrap_monotonic(Head) :-
 1598    '$wrap_predicate'(Head, monotonic, _Closure, Wrapped,
 1599                      '$start_monotonic'(Head, Wrapped)),
 1600    '$pi_head'(PI, Head),
 1601    prolog_listen(PI, monotonic_update).
 1602
 1603%!  unwrap_monotonic(+Head)
 1604%
 1605%   Remove the monotonic wrappers and dependencies.
 1606
 1607unwrap_monotonic(Head) :-
 1608    '$pi_head'(PI, Head),
 1609    (   unwrap_predicate(PI, monotonic)
 1610    ->  prolog_unlisten(PI, monotonic_update)
 1611    ;   true
 1612    ).
 1613
 1614%!  '$start_monotonic'(+Head, +Wrapped)
 1615%
 1616%   This is called the monotonic wrapper   around a dynamic predicate to
 1617%   collect the dependencies  between  the   dynamic  predicate  and the
 1618%   monotonic tabled predicates.
 1619
 1620'$start_monotonic'(Head, Wrapped) :-
 1621    (   '$tbl_collect_mono_dep'
 1622    ->  shift(dependency(Head)),
 1623        tdebug(monotonic, 'Cont in $start_dynamic/2 with ~p', [Head]),
 1624        Wrapped,
 1625        tdebug(monotonic, '  --> ~p', [Head])
 1626    ;   Wrapped
 1627    ).
 1628
 1629%!  monotonic_update(+Action, +ClauseRef)
 1630%
 1631%   Trap changes to the monotonic dynamic predicate and forward them.
 1632
 1633:- public monotonic_update/2. 1634monotonic_update(Action, ClauseRef) :-
 1635    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1636    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1637        mon_propagate(Action, Head, ClauseRef)
 1638    ;   true
 1639    ).
 1640
 1641%!  mon_propagate(+Action, +Head, +ClauseRef)
 1642%
 1643%   Handle changes to a dynamic predicate as part of monotonic
 1644%   updates.
 1645
 1646mon_propagate(Action, Head, ClauseRef) :-
 1647    assert_action(Action),
 1648    !,
 1649    setup_call_cleanup(
 1650        '$tbl_propagate_start'(Old),
 1651        propagate_assert(Head),                 % eager monotonic dependencies
 1652        '$tbl_propagate_end'(Old)),
 1653    forall(dyn_affected(Head, ATrie),
 1654           '$mono_idg_changed'(ATrie, ClauseRef)). % lazy monotonic dependencies
 1655mon_propagate(retract, Head, _) :-
 1656    !,
 1657    mon_invalidate_dependents(Head).
 1658mon_propagate(rollback(Action), Head, _) :-
 1659    mon_propagate_rollback(Action, Head).
 1660
 1661mon_propagate_rollback(Action, _Head) :-
 1662    assert_action(Action),
 1663    !.
 1664mon_propagate_rollback(retract, Head) :-
 1665    mon_invalidate_dependents(Head).
 1666
 1667assert_action(asserta).
 1668assert_action(assertz).
 1669
 1670%!  propagate_assert(+Head) is det.
 1671%
 1672%   Propagate assertion of a dynamic clause with head Head.
 1673
 1674propagate_assert(Head) :-
 1675    tdebug(monotonic, 'Asserted ~p', [Head]),
 1676    (   monotonic_dyn_affects(Head, Cont, Skel, ATrie),
 1677        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1678        '$idg_set_current'(_, ATrie),
 1679        pdelim(Cont, Skel, ATrie),
 1680        fail
 1681    ;   true
 1682    ).
 1683
 1684%!  incr_propagate_assert(+Head) is det.
 1685%
 1686%   Propagate assertion of a dynamic clause with head Head, both
 1687%   through eager and dynamic tables.
 1688
 1689incr_propagate_assert(Head) :-
 1690    tdebug(monotonic, 'New dynamic answer ~p', [Head]),
 1691    (   dyn_affected(Head, DTrie),
 1692         '$idg_mono_affects'(DTrie, ATrie,
 1693                             dependency(Head, Cont, Skel)),
 1694        tdebug(monotonic, 'Propagating dyn ~p to ~p', [Head, ATrie]),
 1695        '$idg_set_current'(_, ATrie),
 1696        pdelim(Cont, Skel, ATrie),
 1697        fail
 1698    ;   true
 1699    ).
 1700
 1701
 1702%!  propagate_answer(+SrcTrie, +SrcSkel) is det.
 1703%
 1704%   Propagate the new answer SrcSkel to the answer table SrcTrie.
 1705
 1706propagate_answer(SrcTrie, SrcSkel) :-
 1707    (   monotonic_affects(SrcTrie, SrcSkel, true, Cont, Skel, ATrie),
 1708        tdebug(monotonic, 'Propagating tab ~p to ~p', [SrcTrie, ATrie]),
 1709        pdelim(Cont, Skel, ATrie),
 1710        fail
 1711    ;   true
 1712    ).
 1713
 1714%!  pdelim(+Worker, +Skel, +ATrie)
 1715%
 1716%   Call Worker (a continuation) and add   each  binding it provides for
 1717%   Skel  to  ATrie.  If  a  new  answer    is  added  to  ATrie,  using
 1718%   propagate_answer/2 to propagate this further. Note   that we may hit
 1719%   new dependencies and thus we need to run this using reset/3.
 1720%
 1721%   @tbd Not sure whether we need full   tabling  here. Need to think of
 1722%   test cases.
 1723
 1724pdelim(Worker, Skel, ATrie) :-
 1725    reset(Worker, Dep, Cont),
 1726    (   Cont == 0
 1727    ->  '$tbl_monotonic_add_answer'(ATrie, Skel),
 1728        propagate_answer(ATrie, Skel)
 1729    ;   mon_assert_dep(Dep, Cont, Skel, ATrie),
 1730        pdelim(Cont, Skel, ATrie)
 1731    ).
 1732
 1733%!  mon_invalidate_dependents(+Head)
 1734%
 1735%   A non-monotonic operation was done on Head. Invalidate all dependent
 1736%   tables, preparing for normal incremental   reevaluation  on the next
 1737%   cycle.
 1738
 1739mon_invalidate_dependents(Head) :-
 1740    tdebug(monotonic, 'Invalidate dependents for ~p', [Head]),
 1741    forall(dyn_affected(Head, ATrie),
 1742           '$idg_mono_invalidate'(ATrie)).
 1743
 1744%!  abolish_monotonic_tables
 1745%
 1746%   Abolish all monotonic tables and the monotonic dependency relations.
 1747%
 1748%   @tbd: just prepare for incremental reevaluation?
 1749
 1750abolish_monotonic_tables :-
 1751    (   '$tbl_variant_table'(VariantTrie),
 1752        trie_gen(VariantTrie, Goal, ATrie),
 1753        '$get_predicate_attribute'(Goal, monotonic, 1),
 1754        '$tbl_destroy_table'(ATrie),
 1755        fail
 1756    ;   true
 1757    ).
 1758
 1759		 /*******************************
 1760		 *      INCREMENTAL TABLING	*
 1761		 *******************************/
 1762
 1763%!  wrap_incremental(:Head) is det.
 1764%
 1765%   Wrap an incremental dynamic predicate to be added to the IDG.
 1766
 1767wrap_incremental(Head) :-
 1768    tdebug(monotonic, 'Wrapping ~p', [Head]),
 1769    abstract_goal(Head, Abstract),
 1770    '$pi_head'(PI, Head),
 1771    (   Head == Abstract
 1772    ->  prolog_listen(PI, dyn_update)
 1773    ;   prolog_listen(PI, dyn_update(Abstract))
 1774    ).
 1775
 1776abstract_goal(M:Head, M:Abstract) :-
 1777    compound(Head),
 1778    '$get_predicate_attribute'(M:Head, abstract, 1),
 1779    !,
 1780    compound_name_arity(Head, Name, Arity),
 1781    functor(Abstract, Name, Arity).
 1782abstract_goal(Head, Head).
 1783
 1784%!  dyn_update(+Action, +Context) is det.
 1785%
 1786%   Track changes to added or removed clauses. We use '$clause'/4
 1787%   because it works on erased clauses.
 1788%
 1789%   @tbd Add a '$clause_head'(-Head, +ClauseRef) to only decompile the
 1790%   head.
 1791
 1792:- public dyn_update/2, dyn_update/3. 1793
 1794dyn_update(_Action, ClauseRef) :-
 1795    (   atomic(ClauseRef)                       % avoid retractall, start(_)
 1796    ->  '$clause'(Head, _Body, ClauseRef, _Bindings),
 1797        dyn_changed_pattern(Head)
 1798    ;   true
 1799    ).
 1800
 1801dyn_update(Abstract, _, _) :-
 1802    dyn_changed_pattern(Abstract).
 1803
 1804dyn_changed_pattern(Term) :-
 1805    forall(dyn_affected(Term, ATrie),
 1806           '$idg_changed'(ATrie)).
 1807
 1808dyn_affected(Term, ATrie) :-
 1809    '$tbl_variant_table'(VTable),
 1810    trie_gen(VTable, Term, ATrie).
 1811
 1812%!  unwrap_incremental(:Head) is det.
 1813%
 1814%   Remove dynamic predicate incremenal forwarding,   reset the possible
 1815%   `abstract` property and remove possible tables.
 1816
 1817unwrap_incremental(Head) :-
 1818    '$pi_head'(PI, Head),
 1819    abstract_goal(Head, Abstract),
 1820    (   Head == Abstract
 1821    ->  prolog_unlisten(PI, dyn_update)
 1822    ;   '$set_predicate_attribute'(Head, abstract, 0),
 1823        prolog_unlisten(PI, dyn_update(_))
 1824    ),
 1825    (   '$tbl_variant_table'(VariantTrie)
 1826    ->  forall(trie_gen(VariantTrie, Head, ATrie),
 1827               '$tbl_destroy_table'(ATrie))
 1828    ;   true
 1829    ).
 1830
 1831%!  reeval(+ATrie, :Goal, ?Return) is nondet.
 1832%
 1833%   Called  if  the   table   ATrie    is   out-of-date   (has  non-zero
 1834%   _falsecount_). The answers of this predicate are the answers to Goal
 1835%   after re-evaluating the answer trie.
 1836%
 1837%   This finds all dependency  paths  to   dynamic  predicates  and then
 1838%   evaluates the nodes in a breath-first  fashion starting at the level
 1839%   just above the dynamic predicates  and   moving  upwards.  Bottom up
 1840%   evaluation is used to profit from upward propagation of not-modified
 1841%   events that may cause the evaluation to stop early.
 1842%
 1843%   Note that false paths either end  in   a  dynamic node or a complete
 1844%   node. The latter happens if we have and  IDG   "D  -> P -> Q" and we
 1845%   first re-evaluate P for some reason.  Now   Q  can  still be invalid
 1846%   after P has been re-evaluated.
 1847%
 1848%   @arg ATrie is the answer trie.  When shared tabling, we own this
 1849%   trie.
 1850%   @arg Goal is tabled goal (variant).  If we run into a deadlock we
 1851%   need to call this.
 1852%   @arg Return is the return skeleton. We must run
 1853%   trie_gen_compiled(ATrie, Return) to enumerate the answers
 1854
 1855reeval(ATrie, Goal, Return) :-
 1856    catch(try_reeval(ATrie, Goal, Return), deadlock,
 1857          retry_reeval(ATrie, Goal)).
 1858
 1859retry_reeval(ATrie, Goal) :-
 1860    '$tbl_reeval_abandon'(ATrie),
 1861    tdebug(deadlock, 'Deadlock re-evaluating ~p; retrying', [ATrie]),
 1862    sleep(0.000001),
 1863    call(Goal).
 1864
 1865try_reeval(ATrie, Goal, Return) :-
 1866    nb_current('$tbl_reeval', true),
 1867    !,
 1868    tdebug(reeval, 'Nested re-evaluation for ~p', [ATrie]),
 1869    do_reeval(ATrie, Goal, Return).
 1870try_reeval(ATrie, Goal, Return) :-
 1871    tdebug(reeval, 'Planning reeval for ~p', [ATrie]),
 1872    findall(Path, false_path(ATrie, Path), Paths0),
 1873    sort(0, @>, Paths0, Paths1),
 1874    clean_paths(Paths1, Paths),
 1875    tdebug(forall('$member'(Path, Paths),
 1876                  tdebug(reeval, '  Re-eval complete path: ~p', [Path]))),
 1877    reeval_paths(Paths, ATrie),
 1878    do_reeval(ATrie, Goal, Return).
 1879
 1880do_reeval(ATrie, Goal, Return) :-
 1881    '$tbl_reeval_prepare_top'(ATrie, Clause),
 1882    (   Clause == 0                          % complete and answer subsumption
 1883    ->  '$tbl_table_status'(ATrie, _Status, M:Variant, Return),
 1884        M:'$table_mode'(Goal0, Variant, ModeArgs),
 1885        Goal = M:Goal0,
 1886        moded_gen_answer(ATrie, Return, ModeArgs)
 1887    ;   nonvar(Clause)                       % complete
 1888    ->  trie_gen_compiled(Clause, Return)
 1889    ;   call(Goal)                           % actually re-evaluate
 1890    ).
 1891
 1892
 1893%!  clean_paths(+PathsIn, -Paths)
 1894%
 1895%   Clean the reevaluation paths. Get rid of   the head term for ranking
 1896%   and remove duplicate paths. Note that  a   Path  is a list of tries,
 1897%   ground terms.
 1898
 1899clean_paths([], []).
 1900clean_paths([[_|Path]|T0], [Path|T]) :-
 1901    clean_paths(T0, Path, T).
 1902
 1903clean_paths([], _, []).
 1904clean_paths([[_|CPath]|T0], CPath, T) :-
 1905    !,
 1906    clean_paths(T0, CPath, T).
 1907clean_paths([[_|Path]|T0], _, [Path|T]) :-
 1908    clean_paths(T0, Path, T).
 1909
 1910%!  reeval_paths(+Paths, +Atrie)
 1911%
 1912%   Make Atrie valid again by re-evaluating nodes   in Paths. We stop as
 1913%   soon as Atrie  is  valid  again.  Note   that  we  may  not  need to
 1914%   reevaluate all paths because evaluating the   head  of some path may
 1915%   include other nodes in an SCC, making them valid as well.
 1916
 1917reeval_paths([], _) :-
 1918    !.
 1919reeval_paths(BottomUp, ATrie) :-
 1920    is_invalid(ATrie),
 1921    !,
 1922    reeval_heads(BottomUp, ATrie, BottomUp1),
 1923    tdebug(assertion(BottomUp \== BottomUp1)),
 1924    '$list_to_set'(BottomUp1, BottomUp2),
 1925    reeval_paths(BottomUp2, ATrie).
 1926reeval_paths(_, _).
 1927
 1928reeval_heads(_, ATrie, []) :-                % target is valid again
 1929    \+ is_invalid(ATrie),
 1930    !.
 1931reeval_heads([], _, []).
 1932reeval_heads([[H]|B], ATrie, BT) :-          % Last one of a falsepath
 1933    reeval_node(H),
 1934    !,
 1935    reeval_heads(B, ATrie, BT).
 1936reeval_heads([[H|T]|B], ATrie, [T|BT]) :-
 1937    reeval_node(H),
 1938    !,
 1939    reeval_heads(B, ATrie, BT).
 1940reeval_heads([FP|B], ATrie, [FP|BT]) :-
 1941    reeval_heads(B, ATrie, BT).
 1942
 1943
 1944%!  false_path(+Atrie, -Path) is nondet.
 1945%
 1946%   True when Path is a list of   invalid  tries (bottom up, ending with
 1947%   ATrie).   The   last   element   of    the     list    is   a   term
 1948%   `s(Rank,Length,ATrie)` that is used for sorting the paths.
 1949%
 1950%   If we find a table along the  way   that  is being worked on by some
 1951%   other thread we wait for it.
 1952
 1953false_path(ATrie, BottomUp) :-
 1954    false_path(ATrie, Path, []),
 1955    '$reverse'(Path, BottomUp).
 1956
 1957false_path(ATrie, [ATrie|T], Seen) :-
 1958    \+ memberchk(ATrie, Seen),
 1959    '$idg_false_edge'(ATrie, Dep, Status),
 1960    tdebug(reeval, '    ~p has dependent ~p (~w)', [ATrie, Dep, Status]),
 1961    (   Status == invalid
 1962    ->  (   false_path(Dep, T, [ATrie|Seen])
 1963        ->  true
 1964        ;   length(Seen, Len),               % invalid has no dependencies:
 1965            T = [s(2, Len, [])]              % dynamic and tabled or explicitly
 1966        )                                    % invalidated
 1967    ;   status_rank(Status, Rank),
 1968        length(Seen, Len),
 1969        T = [s(Rank,Len,Dep)]
 1970    ).
 1971
 1972status_rank(dynamic,   2) :- !.
 1973status_rank(monotonic, 2) :- !.
 1974status_rank(complete,  1) :- !.
 1975status_rank(Status,    Rank) :-
 1976    var(Rank),
 1977    !,
 1978    format(user_error, 'Re-eval from status ~p~n', [Status]),
 1979    Rank = 0.
 1980status_rank(Rank,   Rank) :-
 1981    format(user_error, 'Re-eval from rank ~p~n', [Rank]).
 1982
 1983is_invalid(ATrie) :-
 1984    '$idg_falsecount'(ATrie, FalseCount),
 1985    FalseCount > 0.
 1986
 1987%!  reeval_node(+ATrie) is semidet.
 1988%
 1989%   Re-evaluate the invalid answer trie ATrie.  Initially this created a
 1990%   nested tabling environment, but this is dropped:
 1991%
 1992%     - It is possible for the re-evaluating variant to call into outer
 1993%       non/not-yet incremental tables, requiring a merge with this
 1994%       outer SCC.  This doesn't work well with a sub-environment.
 1995%     - We do not need one.  If this environment is not merged into the
 1996%       outer one it will complete before we continue.
 1997%
 1998%   Fails if the node is not ready for   evaluation. This is the case if
 1999%   it is valid or it is a lazy table that has invalid dependencies.
 2000
 2001reeval_node(ATrie) :-
 2002    '$tbl_reeval_prepare'(ATrie, M:Variant),
 2003    !,
 2004    M:'$table_mode'(Goal0, Variant, _Moded),
 2005    Goal = M:Goal0,
 2006    tdebug(reeval, 'Re-evaluating ~p', [Goal]),
 2007    (   '$idg_reset_current',
 2008        setup_call_cleanup(
 2009            nb_setval('$tbl_reeval', true),
 2010            ignore(Goal),                    % assumes local scheduling
 2011            nb_delete('$tbl_reeval')),
 2012        fail
 2013    ;   tdebug(reeval, 'Re-evaluated ~p', [Goal])
 2014    ).
 2015reeval_node(ATrie) :-
 2016    '$mono_reeval_prepare'(ATrie, Size),
 2017    !,
 2018    reeval_monotonic_node(ATrie, Size).
 2019reeval_node(ATrie) :-
 2020    \+ is_invalid(ATrie).
 2021
 2022reeval_monotonic_node(ATrie, Size) :-
 2023    setup_call_cleanup(
 2024        '$tbl_propagate_start'(Old),
 2025        reeval_monotonic_node(ATrie, Size, Deps),
 2026        '$tbl_propagate_end'(Old)),
 2027    (   Deps == []
 2028    ->  tdebug(reeval, 'Re-evaluation for ~p complete', [ATrie])
 2029    ;   Deps == false
 2030    ->  tdebug(reeval, 'Re-evaluation for ~p queued new answers', [ATrie]),
 2031        reeval_node(ATrie)
 2032    ;   tdebug(reeval, 'Re-evaluation for ~p: new invalid deps: ~p',
 2033               [ATrie, Deps]),
 2034        reeval_nodes(Deps),
 2035        reeval_node(ATrie)
 2036    ).
 2037
 2038%!  reeval_nodes(+Nodes:list(trie)) is det.
 2039%
 2040%   After pulling in the monotonic answers  into   some  node, this is a
 2041%   list if invalid dependencies.  We must revaluate these and then pull
 2042%   in possible queued answers before we are done.
 2043
 2044reeval_nodes([]).
 2045reeval_nodes([H|T]) :-
 2046    reeval_node(H),
 2047    reeval_nodes(T).
 2048
 2049reeval_monotonic_node(ATrie, Size, Deps) :-
 2050    tdebug(reeval, 'Re-evaluating lazy monotonic ~p', [ATrie]),
 2051    (   '$idg_mono_affects_lazy'(ATrie, _0SrcTrie, Dep, DepRef, Answers),
 2052        length(Answers, Count),
 2053        '$idg_mono_empty_queue'(DepRef, Count),
 2054        (   Dep = dependency(Head, Cont, Skel)
 2055        ->  (   '$member'(ClauseRef, Answers),
 2056                '$clause'(Head, _Body, ClauseRef, _Bindings),
 2057                tdebug(monotonic, 'Propagating ~p from ~p to ~p',
 2058                       [Head, _0SrcTrie, ATrie]),
 2059                '$idg_set_current'(_, ATrie),
 2060                pdelim(Cont, Skel, ATrie),
 2061                fail
 2062            ;   true
 2063            )
 2064        ;   Dep = dependency(SrcSkel, true, Cont, Skel)
 2065        ->  (   '$member'(Node, Answers),
 2066                '$tbl_node_answer'(Node, SrcSkel),
 2067                tdebug(monotonic, 'Propagating ~p from ~p to ~p',
 2068                       [Skel, _0SrcTrie, ATrie]),
 2069                '$idg_set_current'(_, ATrie),
 2070                pdelim(Cont, Skel, ATrie),
 2071                fail
 2072            ;   true
 2073            )
 2074        ;   tdebug(monotonic, 'Skipped queued ~p, answers ~p',
 2075                   [Dep, Answers])
 2076        ),
 2077        fail
 2078    ;   '$mono_reeval_done'(ATrie, Size, Deps)
 2079    ).
 2080
 2081
 2082		 /*******************************
 2083		 *      EXPAND DIRECTIVES	*
 2084		 *******************************/
 2085
 2086system:term_expansion((:- table(Preds)), Expansion) :-
 2087    \+ current_prolog_flag(xref, true),
 2088    prolog_load_context(module, M),
 2089    phrase(wrappers(Preds, M), Clauses),
 2090    multifile_decls(Clauses, Directives0),
 2091    sort(Directives0, Directives),
 2092    '$append'(Directives, Clauses, Expansion).
 2093
 2094multifile_decls([], []).
 2095multifile_decls([H0|T0], [H|T]) :-
 2096    multifile_decl(H0, H),
 2097    !,
 2098    multifile_decls(T0, T).
 2099multifile_decls([_|T0], T) :-
 2100    multifile_decls(T0, T).
 2101
 2102multifile_decl(M:(Head :- _Body), (:- multifile(M:Name/Arity))) :-
 2103    !,
 2104    functor(Head, Name, Arity).
 2105multifile_decl(M:Head, (:- multifile(M:Name/Arity))) :-
 2106    !,
 2107    functor(Head, Name, Arity).
 2108multifile_decl((Head :- _Body), (:- multifile(Name/Arity))) :-
 2109    !,
 2110    functor(Head, Name, Arity).
 2111multifile_decl(Head, (:- multifile(Name/Arity))) :-
 2112    !,
 2113    Head \= (:-_),
 2114    functor(Head, Name, Arity).
 2115
 2116
 2117		 /*******************************
 2118		 *      ANSWER COMPLETION	*
 2119		 *******************************/
 2120
 2121:- public answer_completion/2. 2122
 2123%!  answer_completion(+AnswerTrie, +Return) is det.
 2124%
 2125%   Find  positive  loops  in  the  residual   program  and  remove  the
 2126%   corresponding answers, possibly causing   additional simplification.
 2127%   This is called from C  if   simplify_component()  detects  there are
 2128%   conditional answers after simplification.
 2129%
 2130%   Note that we are called recursively from   C.  Our caller prepared a
 2131%   clean new tabling environment and restores   the  old one after this
 2132%   predicate terminates.
 2133%
 2134%   @author This code is by David Warren as part of XSB.
 2135%   @see called from C, pl-tabling.c, answer_completion()
 2136
 2137answer_completion(AnswerTrie, Return) :-
 2138    tdebug(trie_goal(AnswerTrie, Goal, _Return)),
 2139    tdebug(ac(start), 'START: Answer completion for ~p', [Goal]),
 2140    call_cleanup(answer_completion_guarded(AnswerTrie, Return, Propagated),
 2141                 abolish_table_subgoals(eval_subgoal_in_residual(_,_))),
 2142    (   Propagated > 0
 2143    ->  answer_completion(AnswerTrie, Return)
 2144    ;   true
 2145    ).
 2146
 2147answer_completion_guarded(AnswerTrie, Return, Propagated) :-
 2148    (   eval_subgoal_in_residual(AnswerTrie, Return),
 2149        fail
 2150    ;   true
 2151    ),
 2152    delete_answers_for_failing_calls(Propagated),
 2153    (   Propagated == 0
 2154    ->  mark_succeeding_calls_as_answer_completed
 2155    ;   true
 2156    ).
 2157
 2158%!  delete_answers_for_failing_calls(-Propagated)
 2159%
 2160%   Delete answers whose condition  is  determined   to  be  `false` and
 2161%   return the number of additional  answers   that  changed status as a
 2162%   consequence of additional simplification propagation.
 2163
 2164delete_answers_for_failing_calls(Propagated) :-
 2165    State = state(0),
 2166    (   subgoal_residual_trie(ASGF, ESGF),
 2167        \+ trie_gen(ESGF, _ETmp),
 2168        tdebug(trie_goal(ASGF, Goal0, _)),
 2169        tdebug(trie_goal(ASGF, Goal, _0Return)),
 2170        '$trie_gen_node'(ASGF, _0Return, ALeaf),
 2171        tdebug(ac(prune), '  Removing answer ~p from ~p', [Goal, Goal0]),
 2172	'$tbl_force_truth_value'(ALeaf, false, Count),
 2173        arg(1, State, Prop0),
 2174        Prop is Prop0+Count-1,
 2175        nb_setarg(1, State, Prop),
 2176	fail
 2177    ;   arg(1, State, Propagated)
 2178    ).
 2179
 2180mark_succeeding_calls_as_answer_completed :-
 2181    (   subgoal_residual_trie(ASGF, _ESGF),
 2182        (   '$tbl_answer_dl'(ASGF, _0Return, _True)
 2183        ->  tdebug(trie_goal(ASGF, Answer, _0Return)),
 2184            tdebug(trie_goal(ASGF, Goal, _0Return)),
 2185            tdebug(ac(prune), '  Completed ~p on ~p', [Goal, Answer]),
 2186            '$tbl_set_answer_completed'(ASGF)
 2187        ),
 2188        fail
 2189    ;   true
 2190    ).
 2191
 2192subgoal_residual_trie(ASGF, ESGF) :-
 2193    '$tbl_variant_table'(VariantTrie),
 2194    context_module(M),
 2195    trie_gen(VariantTrie, M:eval_subgoal_in_residual(ASGF, _), ESGF).
 2196
 2197%!  eval_dl_in_residual(+Condition)
 2198%
 2199%   Evaluate a condition by only looking at   the  residual goals of the
 2200%   involved calls.
 2201
 2202eval_dl_in_residual(true) :-
 2203    !.
 2204eval_dl_in_residual((A;B)) :-
 2205    !,
 2206    (   eval_dl_in_residual(A)
 2207    ;   eval_dl_in_residual(B)
 2208    ).
 2209eval_dl_in_residual((A,B)) :-
 2210    !,
 2211    eval_dl_in_residual(A),
 2212    eval_dl_in_residual(B).
 2213eval_dl_in_residual(tnot(G)) :-
 2214    !,
 2215    tdebug(ac, ' ? tnot(~p)', [G]),
 2216    current_table(G, SGF),
 2217    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2218    tnot(eval_subgoal_in_residual(SGF, Return)).
 2219eval_dl_in_residual(G) :-
 2220    tdebug(ac, ' ? ~p', [G]),
 2221    (   current_table(G, SGF)
 2222    ->	true
 2223    ;   more_general_table(G, SGF)
 2224    ->	true
 2225    ;	writeln(user_error, 'MISSING CALL? '(G)),
 2226        fail
 2227    ),
 2228    '$tbl_table_status'(SGF, _Status, _Wrapper, Return),
 2229    eval_subgoal_in_residual(SGF, Return).
 2230
 2231more_general_table(G, Trie) :-
 2232    term_variables(G, Vars),
 2233    '$tbl_variant_table'(VariantTrie),
 2234    trie_gen(VariantTrie, G, Trie),
 2235    is_most_general_term(Vars).
 2236
 2237:- table eval_subgoal_in_residual/2. 2238
 2239%!  eval_subgoal_in_residual(+AnswerTrie, ?Return)
 2240%
 2241%   Derive answers for the variant represented   by  AnswerTrie based on
 2242%   the residual goals only.
 2243
 2244eval_subgoal_in_residual(AnswerTrie, _Return) :-
 2245    '$tbl_is_answer_completed'(AnswerTrie),
 2246    !,
 2247    undefined.
 2248eval_subgoal_in_residual(AnswerTrie, Return) :-
 2249    '$tbl_answer'(AnswerTrie, Return, Condition),
 2250    tdebug(trie_goal(AnswerTrie, Goal, Return)),
 2251    tdebug(ac, 'Condition for ~p is ~p', [Goal, Condition]),
 2252    eval_dl_in_residual(Condition).
 2253
 2254
 2255		 /*******************************
 2256		 *            TRIPWIRES		*
 2257		 *******************************/
 2258
 2259%!  tripwire(+Wire, +Action, +Context)
 2260%
 2261%   Called from the tabling engine of some  tripwire is exceeded and the
 2262%   situation  is  not  handled  internally   (such  as  `abstract`  and
 2263%   `bounded_rationality`.
 2264
 2265:- public tripwire/3. 2266:- multifile prolog:tripwire/2. 2267
 2268tripwire(Wire, _Action, Context) :-
 2269    prolog:tripwire(Wire, Context),
 2270    !.
 2271tripwire(Wire, Action, Context) :-
 2272    Error = error(resource_error(tripwire(Wire, Context)), _),
 2273    tripwire_action(Action, Error).
 2274
 2275tripwire_action(warning, Error) :-
 2276    print_message(warning, Error).
 2277tripwire_action(error, Error) :-
 2278    throw(Error).
 2279tripwire_action(suspend, Error) :-
 2280    print_message(warning, Error),
 2281    break.
 2282
 2283
 2284		 /*******************************
 2285		 *   SYSTEM TABLED PREDICATES	*
 2286		 *******************************/
 2287
 2288:- table
 2289    system:undefined/0,
 2290    system:answer_count_restraint/0,
 2291    system:radial_restraint/0,
 2292    system:tabled_call/1. 2293
 2294%!  undefined is undefined.
 2295%
 2296%   Expresses the value _bottom_ from the well founded semantics.
 2297
 2298system:(undefined :-
 2299    tnot(undefined)).
 2300
 2301%!  answer_count_restraint is undefined.
 2302%!  radial_restraint is undefined.
 2303%
 2304%   Similar  to  undefined/0,  providing  a   specific  _undefined_  for
 2305%   restraint violations.
 2306
 2307system:(answer_count_restraint :-
 2308    tnot(answer_count_restraint)).
 2309
 2310system:(radial_restraint :-
 2311    tnot(radial_restraint)).
 2312
 2313system:(tabled_call(X) :- call(X))