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