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, Benoit Desouter, Jan Wielemaker, Fabrizio Riguzzi
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(tabling,
   36          [ (table)/1,                  % +PI ...
   37
   38            current_table/2,            % :Variant, ?Table
   39            abolish_all_tables/0,
   40            abolish_table_subgoals/1,   % :Subgoal
   41
   42            start_tabling/2,            % +Wrapper, :Worker.
   43
   44            op(1150, fx, table)
   45          ]).   46:- use_module(library(error)).   47:- set_prolog_flag(generate_debug_info, false).   48
   49:- meta_predicate
   50    start_tabling(+, 0),
   51    current_table(:, -),
   52    abolish_table_subgoals(:).

 table(+PredicateIndicators)

Prepare the given PredicateIndicators for tabling. Can only be used as a directive. The example below prepares the predicate edge/2 and the non-terminal statement//1 for tabled execution.

:- table edge/2, statement//1.

In addition to using predicate indicators, a predicate can be declared for mode directed tabling using a term where each argument declares the intended mode. For example:

:- table connection(_,_,min).

Mode directed tabling is discussed in the general introduction section about tabling.

   85table(PIList) :-
   86    throw(error(context_error(nodirective, table(PIList)), _)).

 start_tabling(+Variant, +Implementation)

Execute Implementation using tabling. This predicate should not be called directly. The table/1 directive causes a predicate to be translated into a renamed implementation and a wrapper that involves this predicate.

Compatibility

- This interface may change or disappear without notice from future versions.

   98start_tabling(Wrapper, Worker) :-
   99    get_wrapper_no_mode_args(Wrapper, WrapperNoModes, ModeArgs),
  100    '$tbl_variant_table'(WrapperNoModes, Trie, Status),
  101    (   Status == complete
  102    ->  trie_gen(Trie, WrapperNoModes, ModeArgs)
  103    ;   (   '$tbl_scheduling_component'(false, true)
  104        ->  catch(run_leader(Wrapper, WrapperNoModes, Worker, Trie),
  105                  E, true),
  106            (   var(E)
  107            ->  trie_gen(Trie, WrapperNoModes, ModeArgs)
  108            ;   '$tbl_table_discard_all',
  109                throw(E)
  110            )
  111        ;   run_follower(Status, Wrapper, WrapperNoModes, Worker, Trie)
  112        )
  113    ).
  114
  115get_wrapper_no_mode_args(M:Wrapper, M:WrapperNoModes, ModeArgs) :-
  116    M:'$table_mode'(Wrapper, WrapperNoModes, ModeArgs).
  117
  118run_follower(fresh, Wrapper, WrapperNoModes, Worker, Trie) :-
  119    !,
  120    activate(Wrapper, WrapperNoModes, Worker, Trie, Worklist),
  121    shift(call_info(Wrapper, Worklist)).
  122run_follower(Worklist, Wrapper, _WrapperNoModes, _Worker, _Trie) :-
  123    shift(call_info(Wrapper, Worklist)).
  124
  125run_leader(Wrapper, WrapperNoModes, Worker, Trie) :-
  126    activate(Wrapper, WrapperNoModes, Worker, Trie, _Worklist),
  127    completion,
  128    '$tbl_scheduling_component'(_, false).
  129
  130activate(Wrapper, WrapperNoModes, Worker, Trie, WorkList) :-
  131    '$tbl_new_worklist'(WorkList, Trie),
  132    (   delim(Wrapper, WrapperNoModes, Worker, WorkList),
  133        fail
  134    ;   true
  135    ).

 delim(+Wrapper, +Worker, +WorkList)

 delim(+Wrapper, +WrapperNoModes, +Worker, +WorkList)

Call/resume Worker

  142delim(Wrapper, Worker, WorkList) :-
  143    reset(Worker, SourceCall, Continuation),
  144    add_answer_or_suspend(Continuation, Wrapper,
  145                          WorkList, SourceCall).
  146
  147add_answer_or_suspend(0, Wrapper, WorkList, _) :-
  148    !,
  149    '$tbl_wkl_add_answer'(WorkList, Wrapper).
  150add_answer_or_suspend(Continuation, Wrapper, WorkList,
  151                      call_info(SrcWrapper, SourceWL)) :-
  152    '$tbl_wkl_add_suspension'(
  153        SourceWL,
  154        dependency(SrcWrapper, Continuation, Wrapper, WorkList)).
  155
  156delim(Wrapper, WrapperNoModes, Worker, WorkList) :-
  157    reset(Worker, SourceCall, Continuation),
  158    add_answer_or_suspend(Continuation, Wrapper, WrapperNoModes,
  159                          WorkList, SourceCall).
  160
  161add_answer_or_suspend(0, Wrapper, WrapperNoModes, WorkList, _) :-
  162    !,
  163    get_wrapper_no_mode_args(Wrapper, _, ModeArgs),
  164    '$tbl_wkl_mode_add_answer'(WorkList, WrapperNoModes,
  165                               ModeArgs, Wrapper).
  166add_answer_or_suspend(Continuation, Wrapper, _WrapperNoModes, WorkList,
  167                      call_info(SrcWrapper, SourceWL)) :-
  168    '$tbl_wkl_add_suspension'(
  169        SourceWL,
  170        dependency(SrcWrapper, Continuation, Wrapper, WorkList)).

 update(+Wrapper, +A1, +A2, -A3) is det

Update the aggregated value for an answer. Wrapper is the tabled goal, A1 is the aggregated value so far, A2 is the new answer and A3 should be unified with the new aggregated value. The new aggregate is ignored if it is the same as the old one.

  179:- public
  180    update/4.  181
  182update(M:Wrapper, A1, A2, A3) :-
  183    M:'$table_update'(Wrapper, A1, A2, A3),
  184    A1 \=@= A3.

 completion

Wakeup suspended goals until no new answers are generated.

  191completion :-
  192    '$tbl_pop_worklist'(WorkList),
  193    !,
  194    completion_step(WorkList),
  195    completion.
  196completion :-
  197    '$tbl_table_complete_all'.
  198
  199completion_step(SourceTable) :-
  200    (   '$tbl_trienode'(Reserved),
  201        '$tbl_wkl_work'(SourceTable,
  202                        Answer, ModeArgs,
  203                        Goal, Continuation, Wrapper, TargetTable),
  204        (   ModeArgs == Reserved
  205        ->  Goal = Answer,
  206            delim(Wrapper, Continuation, TargetTable)
  207        ;   get_wrapper_no_mode_args(Goal, Answer, ModeArgs),
  208            get_wrapper_no_mode_args(Wrapper, WrapperNoModes, _),
  209            delim(Wrapper, WrapperNoModes, Continuation, TargetTable)
  210        ),
  211        fail
  212    ;   true
  213    ).
  214
  215                 /*******************************
  216                 *            CLEANUP           *
  217                 *******************************/

 abolish_all_tables

Remove all tables. This is normally used to free up the space or recompute the result after predicates on which the result for some tabled predicates depend.

Errors

- permission_error(abolish, table, all) if tabling is in progress.

  228abolish_all_tables :-
  229    '$tbl_abolish_all_tables'.

 abolish_table_subgoals(:Subgoal) is det

Abolish all tables that unify with SubGoal.

  235abolish_table_subgoals(M:SubGoal) :-
  236    '$tbl_variant_table'(VariantTrie),
  237    current_module(M),
  238    forall(trie_gen(VariantTrie, M:SubGoal, Trie),
  239           '$tbl_destroy_table'(Trie)).
  240
  241
  242                 /*******************************
  243                 *        EXAMINE TABLES        *
  244                 *******************************/

 current_table(:Variant, -Trie) is nondet

True when Trie is the answer table for Variant.

  250current_table(M:Variant, Trie) :-
  251    '$tbl_variant_table'(VariantTrie),
  252    (   (var(Variant) ; var(M))
  253    ->  trie_gen(VariantTrie, M:Variant, Trie)
  254    ;   trie_lookup(VariantTrie, M:Variant, Trie)
  255    ).
  256
  257
  258                 /*******************************
  259                 *      WRAPPER GENERATION      *
  260                 *******************************/
  261
  262:- multifile
  263    system:term_expansion/2,
  264    prolog:rename_predicate/2,
  265    tabled/2.  266:- dynamic
  267    system:term_expansion/2.  268
  269wrappers(Var) -->
  270    { var(Var),
  271      !,
  272      instantiation_error(Var)
  273    }.
  274wrappers((A,B)) -->
  275    !,
  276    wrappers(A),
  277    wrappers(B).
  278wrappers(Name//Arity) -->
  279    { atom(Name), integer(Arity), Arity >= 0,
  280      !,
  281      Arity1 is Arity+2
  282    },
  283    wrappers(Name/Arity1).
  284wrappers(Name/Arity) -->
  285    { atom(Name), integer(Arity), Arity >= 0,
  286      !,
  287      functor(Head, Name, Arity),
  288      atom_concat(Name, ' tabled', WrapName),
  289      Head =.. [Name|Args],
  290      WrappedHead =.. [WrapName|Args],
  291      prolog_load_context(module, Module),
  292      '$tbl_trienode'(Reserved)
  293    },
  294    [ '$tabled'(Head),
  295      '$table_mode'(Head, Head, Reserved),
  296      (   Head :-
  297             start_tabling(Module:Head, WrappedHead)
  298      )
  299    ].
  300wrappers(ModeDirectedSpec) -->
  301    { callable(ModeDirectedSpec),
  302      !,
  303      functor(ModeDirectedSpec, Name, Arity),
  304      functor(Head, Name, Arity),
  305      atom_concat(Name, ' tabled', WrapName),
  306      Head =.. [Name|Args],
  307      WrappedHead =.. [WrapName|Args],
  308      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
  309      updater_clauses(Modes, Head, UpdateClauses),
  310      prolog_load_context(module, Module)
  311    },
  312    [ '$tabled'(Head),
  313      '$table_mode'(Head, Variant, Moded),
  314      (   Head :-
  315             start_tabling(Module:Head, WrappedHead)
  316      )
  317    | UpdateClauses
  318    ].
  319wrappers(TableSpec) -->
  320    { type_error(table_desclaration, TableSpec)
  321    }.

 extract_modes(+ModeSpec, +Head, -Variant, -Modes, -ModedAnswer) is det

Split Head into its variant and term that matches the moded arguments.

Arguments:

ModedAnswer

- is a term that captures that value of all moded arguments of an answer. If there is only one, this is the value itself. If there are multiple, this is a term s(A1,A2,...)

  333extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
  334    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
  335    compound_name_arguments(Head, Name, HeadArgs),
  336    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
  337    Variant =.. [Name|VariantArgs],
  338    (   ModedArgs == []
  339    ->  '$tbl_trienode'(ModedAnswer)
  340    ;   ModedArgs = [ModedAnswer]
  341    ->  true
  342    ;   ModedAnswer =.. [s|ModedArgs]
  343    ).

 separate_args(+ModeSpecArgs, +HeadArgs, -NoModesArgs, -Modes, -ModeArgs) is det

Split the arguments in those that need to be part of the variant identity (NoModesArgs) and those that are aggregated (ModeArgs).

Arguments:

Args	- seems a copy of ModeArgs, why?

  353separate_args([], [], [], [], []).
  354separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
  355    indexed_mode(HM),
  356    !,
  357    separate_args(TM, TA, TNA, Modes, TMA).
  358separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
  359    separate_args(TM, TA, TNA, Modes, TMA).
  360
  361indexed_mode(Mode) :-                           % XSB
  362    var(Mode),
  363    !.
  364indexed_mode(index).                            % YAP
  365indexed_mode(+).                                % B

 updater_clauses(+Modes, +Head, -Clauses)

Generates a clause to update the aggregated state. Modes is a list of predicate names we apply to the state.

  372updater_clauses([], _, []) :- !.
  373updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
  374    update_goal(P, S0,S1,S2, Body).
  375updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
  376    length(Modes, Len),
  377    functor(S0, s, Len),
  378    functor(S1, s, Len),
  379    functor(S2, s, Len),
  380    S0 =.. [_|Args0],
  381    S1 =.. [_|Args1],
  382    S2 =.. [_|Args2],
  383    update_body(Modes, Args0, Args1, Args2, true, Body).
  384
  385update_body([], _, _, _, Body, Body).
  386update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
  387    update_goal(P, A0,A1,A2, Goal),
  388    mkconj(Body0, Goal, Body1),
  389    update_body(TM, Args0, Args1, Args2, Body1, Body).
  390
  391update_goal(Var, _,_,_, _) :-
  392    var(Var),
  393    !,
  394    instantiation_error(Var).
  395update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
  396    !,
  397    must_be(atom, M),
  398    update_goal(lattice(PI), S0,S1,S2, Goal).
  399update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
  400    !,
  401    must_be(oneof([3]), Arity),
  402    must_be(atom, Name),
  403    Goal =.. [Name,S0,S1,S2].
  404update_goal(lattice(Name), S0,S1,S2, Goal) :-
  405    !,
  406    must_be(atom, Name),
  407    update_goal(lattice(Name/3), S0,S1,S2, Goal).
  408update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
  409    !,
  410    must_be(oneof([2]), Arity),
  411    must_be(atom, Name),
  412    Call =.. [Name, S0, S1],
  413    Goal = (Call -> S2 = S0 ; S2 = S1).
  414update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
  415    !,
  416    must_be(atom, M),
  417    must_be(oneof([2]), Arity),
  418    must_be(atom, Name),
  419    Call =.. [Name, S0, S1],
  420    Goal = (M:Call -> S2 = S0 ; S2 = S1).
  421update_goal(po(M:Name), S0,S1,S2, Goal) :-
  422    !,
  423    must_be(atom, M),
  424    must_be(atom, Name),
  425    update_goal(po(M:Name/2), S0,S1,S2, Goal).
  426update_goal(po(Name), S0,S1,S2, Goal) :-
  427    !,
  428    must_be(atom, Name),
  429    update_goal(po(Name/2), S0,S1,S2, Goal).
  430update_goal(Alias, S0,S1,S2, Goal) :-
  431    update_alias(Alias, Update),
  432    !,
  433    update_goal(Update, S0,S1,S2, Goal).
  434update_goal(Mode, _,_,_, _) :-
  435    domain_error(tabled_mode, Mode).
  436
  437update_alias(first, lattice(tabling:first/3)).
  438update_alias(-,     lattice(tabling:first/3)).
  439update_alias(last,  lattice(tabling:last/3)).
  440update_alias(min,   lattice(tabling:min/3)).
  441update_alias(max,   lattice(tabling:max/3)).
  442update_alias(sum,   lattice(tabling:sum/3)).
  443
  444mkconj(true, G,  G) :- !.
  445mkconj(G1,   G2, (G1,G2)).
  446
  447
  448		 /*******************************
  449		 *          AGGREGATION		*
  450		 *******************************/

 first(+S0, +S1, -S) is det

 last(+S0, +S1, -S) is det

 min(+S0, +S1, -S) is det

 max(+S0, +S1, -S) is det

 sum(+S0, +S1, -S) is det

Implement YAP tabling modes.

  460:- public first/3, last/3, min/3, max/3, sum/3.  461
  462first(S, _, S).
  463last(_, S, S).
  464min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
  465max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
  466sum(S0, S1, S) :- S is S0+S1.
  467
  468
  469		 /*******************************
  470		 *         RENAME WORKER	*
  471		 *******************************/

 prolog:rename_predicate(:Head0, :Head) is semidet

Hook into term_expansion for post processing renaming of the generated predicate.

  478prolog:rename_predicate(M:Head0, M:Head) :-
  479    '$flushed_predicate'(M:'$tabled'(_)),
  480    call(M:'$tabled'(Head0)),
  481    !,
  482    rename_term(Head0, Head).
  483
  484rename_term(Compound0, Compound) :-
  485    compound(Compound0),
  486    !,
  487    compound_name_arguments(Compound0, Name, Args),
  488    atom_concat(Name, ' tabled', WrapName),
  489    compound_name_arguments(Compound, WrapName, Args).
  490rename_term(Name, WrapName) :-
  491    atom_concat(Name, ' tabled', WrapName).
  492
  493
  494system:term_expansion((:- table(Preds)),
  495                      [ (:- multifile('$tabled'/1)),
  496                        (:- multifile('$table_mode'/3)),
  497                        (:- multifile('$table_update'/4))
  498                      | Clauses
  499                      ]) :-
  500    phrase(wrappers(Preds), Clauses).
  501
  502
  503                 /*******************************
  504                 *           SANDBOX            *
  505                 *******************************/
  506
  507:- multifile
  508    sandbox:safe_directive/1,
  509    sandbox:safe_primitive/1,
  510    sandbox:safe_meta/2.

 sandbox:safe_directive(+Directive) is semidet

Allow tabling directives that affect locally defined predicates.

  516sandbox:safe_directive(Dir) :-
  517    ground(Dir),
  518    local_tabling_dir(Dir).
  519
  520local_tabling_dir(table(Preds)) :-
  521    local_preds(Preds).
  522
  523local_preds((A,B)) :-
  524    !,
  525    local_preds(A),
  526    local_preds(B).
  527
  528local_preds(Name/Arity) :-
  529    atom(Name), integer(Arity).
  530local_preds(Name//Arity) :-
  531    atom(Name), integer(Arity).
  532
  533sandbox:safe_meta_predicate(tabling:start_tabling/2).
  534
  535sandbox:safe_primitive(tabling:abolish_all_tables).
  536sandbox:safe_meta(tabling:abolish_table_subgoals(V), []) :-
  537    \+ qualified(V).
  538sandbox:safe_meta(tabling:current_table(V, _), []) :-
  539    \+ qualified(V).
  540
  541qualified(V) :-
  542    nonvar(V),
  543    V = _:_