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