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-2018, Benoit Desouter,
    7                             Jan Wielemaker,
    8                             Fabrizio Riguzzi
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module('$tabling',
   38          [ (table)/1,                  % +PI ...
   39
   40            current_table/2,            % :Variant, ?Table
   41            abolish_all_tables/0,
   42            abolish_table_subgoals/1,   % :Subgoal
   43
   44            start_tabling/2,            % +Wrapper, :Worker
   45            start_tabling/4             % +Wrapper, :Worker, :Variant, ?ModeArgs
   46          ]).   47
   48:- meta_predicate
   49    start_tabling(+, 0),
   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(:Wrapper, :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    '$tbl_variant_table'(Wrapper, Trie, Status),
  100    (   Status == complete
  101    ->  trie_gen(Trie, Wrapper, _)
  102    ;   (   '$tbl_create_component'
  103        ->  catch(run_leader(Wrapper, Worker, Trie),
  104                  E, true),
  105            (   var(E)
  106            ->  trie_gen(Trie, Wrapper, _)
  107            ;   '$tbl_table_discard_all',
  108                throw(E)
  109            )
  110        ;   run_follower(Status, Wrapper, Worker, Trie)
  111        )
  112    ).
  113
  114run_leader(Wrapper, Worker, Trie) :-
  115    activate(Wrapper, Worker, Trie, _Worklist),
  116    completion,
  117    '$tbl_completed_component'.
  118
  119run_follower(fresh, Wrapper, Worker, Trie) :-
  120    !,
  121    activate(Wrapper, Worker, Trie, Worklist),
  122    shift(call_info(Wrapper, Worklist)).
  123run_follower(Worklist, Wrapper, _Worker, _Trie) :-
  124    shift(call_info(Wrapper, Worklist)).
  125
  126activate(Wrapper, Worker, Trie, WorkList) :-
  127    '$tbl_new_worklist'(WorkList, Trie),
  128    (   delim(Wrapper, Worker, WorkList),
  129        fail
  130    ;   true
  131    ).

 start_tabling(:Wrapper, :Implementation, +Variant, +ModeArgs)

As start_tabling/2, but in addition separates the data stored in the answer trie in the Variant and ModeArgs.

  139start_tabling(Wrapper, Worker, WrapperNoModes, ModeArgs) :-
  140    '$tbl_variant_table'(WrapperNoModes, Trie, Status),
  141    (   Status == complete
  142    ->  trie_gen(Trie, WrapperNoModes, ModeArgs)
  143    ;   (   Status == fresh
  144        ->  '$tbl_create_subcomponent',
  145            catch(run_leader(Wrapper, WrapperNoModes, ModeArgs, Worker, Trie),
  146                  E, true),
  147            (   var(E)
  148            ->  trie_gen(Trie, WrapperNoModes, ModeArgs)
  149            ;   '$tbl_table_discard_all',
  150                throw(E)
  151            )
  152        ;   % = run_follower, but never fresh and Status is a worklist
  153            shift(call_info(Wrapper, Status))
  154        )
  155    ).
  156
  157get_wrapper_no_mode_args(M:Wrapper, M:WrapperNoModes, ModeArgs) :-
  158    M:'$table_mode'(Wrapper, WrapperNoModes, ModeArgs).
  159
  160run_leader(Wrapper, WrapperNoModes, ModeArgs, Worker, Trie) :-
  161    activate(Wrapper, WrapperNoModes, ModeArgs, Worker, Trie, _Worklist),
  162    completion,
  163    '$tbl_completed_component'.
  164
  165activate(Wrapper, WrapperNoModes, _ModeArgs, Worker, Trie, WorkList) :-
  166    '$tbl_new_worklist'(WorkList, Trie),
  167    (   delim(Wrapper, WrapperNoModes, Worker, WorkList),
  168        fail
  169    ;   true
  170    ).

 delim(+Wrapper, +Worker, +WorkList)

Call/resume Worker for non-mode directed tabled predicates.

  176delim(Wrapper, Worker, WorkList) :-
  177    reset(work_and_add_answer(Worker, Wrapper, WorkList),
  178          SourceCall, Continuation),
  179    add_answer_or_suspend(Continuation, Wrapper,
  180                          WorkList, SourceCall).
  181
  182work_and_add_answer(Worker, Wrapper, WorkList) :-
  183    call(Worker),
  184    '$tbl_wkl_add_answer'(WorkList, Wrapper).
  185
  186
  187add_answer_or_suspend(0, _Wrapper, _WorkList, _) :-
  188    !.
  189add_answer_or_suspend(Continuation, Wrapper, WorkList,
  190                      call_info(SrcWrapper, SourceWL)) :-
  191    '$tbl_wkl_add_suspension'(
  192        SourceWL,
  193        dependency(SrcWrapper, Continuation, Wrapper, WorkList)).

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

Call/resume Worker for mode directed tabled predicates.

  199delim(Wrapper, WrapperNoModes, Worker, WorkList) :-
  200    reset(work_and_add_moded_answer(Worker, Wrapper, WrapperNoModes, WorkList),
  201          SourceCall, Continuation),
  202    add_answer_or_suspend(Continuation, Wrapper, WrapperNoModes,
  203                          WorkList, SourceCall).
  204
  205work_and_add_moded_answer(Worker, Wrapper, WrapperNoModes, WorkList) :-
  206    call(Worker),
  207    get_wrapper_no_mode_args(Wrapper, _, ModeArgs),
  208    '$tbl_wkl_mode_add_answer'(WorkList, WrapperNoModes,
  209                               ModeArgs, Wrapper).
  210
  211add_answer_or_suspend(0, _Wrapper, _WrapperNoModes, _WorkList, _) :-
  212    !.
  213add_answer_or_suspend(Continuation, Wrapper, _WrapperNoModes, WorkList,
  214                      call_info(SrcWrapper, SourceWL)) :-
  215    '$tbl_wkl_add_suspension'(
  216        SourceWL,
  217        dependency(SrcWrapper, Continuation, Wrapper, WorkList)).

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

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.

  227:- public
  228    update/4.  229
  230update(M:Wrapper, A1, A2, A3) :-
  231    M:'$table_update'(Wrapper, A1, A2, A3),
  232    A1 \=@= A3.

 completion

Wakeup suspended goals until no new answers are generated.

  239completion :-
  240    '$tbl_pop_worklist'(WorkList),
  241    !,
  242    completion_step(WorkList),
  243    completion.
  244completion :-
  245    '$tbl_table_complete_all'.
  246
  247completion_step(SourceTable) :-
  248    (   '$tbl_trienode'(Reserved),
  249        '$tbl_wkl_work'(SourceTable,
  250                        Answer, ModeArgs,
  251                        Goal, Continuation, Wrapper, TargetTable),
  252        (   ModeArgs == Reserved
  253        ->  Goal = Answer,
  254            delim(Wrapper, Continuation, TargetTable)
  255        ;   get_wrapper_no_mode_args(Goal, Answer, ModeArgs),
  256            get_wrapper_no_mode_args(Wrapper, WrapperNoModes, _),
  257            delim(Wrapper, WrapperNoModes, Continuation, TargetTable)
  258        ),
  259        fail
  260    ;   true
  261    ).
  262
  263                 /*******************************
  264                 *            CLEANUP           *
  265                 *******************************/

 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.

  276abolish_all_tables :-
  277    '$tbl_abolish_all_tables'.

 abolish_table_subgoals(:Subgoal) is det

Abolish all tables that unify with SubGoal.

  283abolish_table_subgoals(M:SubGoal) :-
  284    '$tbl_variant_table'(VariantTrie),
  285    current_module(M),
  286    forall(trie_gen(VariantTrie, M:SubGoal, Trie),
  287           '$tbl_destroy_table'(Trie)).
  288
  289
  290                 /*******************************
  291                 *        EXAMINE TABLES        *
  292                 *******************************/

 current_table(:Variant, -Trie) is nondet

True when Trie is the answer table for Variant.

  298current_table(M:Variant, Trie) :-
  299    '$tbl_variant_table'(VariantTrie),
  300    (   (var(Variant) ; var(M))
  301    ->  trie_gen(VariantTrie, M:Variant, Trie)
  302    ;   trie_lookup(VariantTrie, M:Variant, Trie)
  303    ).
  304
  305
  306                 /*******************************
  307                 *      WRAPPER GENERATION      *
  308                 *******************************/
  309
  310:- multifile
  311    system:term_expansion/2,
  312    prolog:rename_predicate/2,
  313    tabled/2.  314:- dynamic
  315    system:term_expansion/2.  316
  317wrappers(Var) -->
  318    { var(Var),
  319      !,
  320      '$instantiation_error'(Var)
  321    }.
  322wrappers((A,B)) -->
  323    !,
  324    wrappers(A),
  325    wrappers(B).
  326wrappers(Name//Arity) -->
  327    { atom(Name), integer(Arity), Arity >= 0,
  328      !,
  329      Arity1 is Arity+2
  330    },
  331    wrappers(Name/Arity1).
  332wrappers(Name/Arity) -->
  333    { atom(Name), integer(Arity), Arity >= 0,
  334      !,
  335      functor(Head, Name, Arity),
  336      check_undefined(Name/Arity),
  337      atom_concat(Name, ' tabled', WrapName),
  338      Head =.. [Name|Args],
  339      WrappedHead =.. [WrapName|Args],
  340      prolog_load_context(module, Module),
  341      '$tbl_trienode'(Reserved)
  342    },
  343    [ '$tabled'(Head),
  344      '$table_mode'(Head, Head, Reserved),
  345      (   Head :-
  346             start_tabling(Module:Head, WrappedHead)
  347      )
  348    ].
  349wrappers(ModeDirectedSpec) -->
  350    { callable(ModeDirectedSpec),
  351      !,
  352      functor(ModeDirectedSpec, Name, Arity),
  353      functor(Head, Name, Arity),
  354      check_undefined(Name/Arity),
  355      atom_concat(Name, ' tabled', WrapName),
  356      Head =.. [Name|Args],
  357      WrappedHead =.. [WrapName|Args],
  358      extract_modes(ModeDirectedSpec, Head, Variant, Modes, Moded),
  359      updater_clauses(Modes, Head, UpdateClauses),
  360      prolog_load_context(module, Module),
  361      mode_check(Moded, ModeTest),
  362      (   ModeTest == true
  363      ->  WrapClause = (Head :- start_tabling(Module:Head, WrappedHead))
  364      ;   WrapClause = (Head :- ModeTest,
  365                            start_tabling(Module:Head, WrappedHead,
  366                                          Module:Variant, Moded))
  367      )
  368    },
  369    [ '$tabled'(Head),
  370      '$table_mode'(Head, Variant, Moded),
  371      WrapClause
  372    | UpdateClauses
  373    ].
  374wrappers(TableSpec) -->
  375    { '$type_error'(table_desclaration, TableSpec)
  376    }.

 check_undefined(+PI)

Verify the predicate has no clauses when the :- table is declared.

To be done

- : future versions may rename the existing predicate.

  384check_undefined(Name/Arity) :-
  385    functor(Head, Name, Arity),
  386    prolog_load_context(module, Module),
  387    clause(Module:Head, _),
  388    !,
  389    '$permission_error'(table, procedure, Name/Arity).
  390check_undefined(_).

 mode_check(+Moded, -TestCode)

Enforce the output arguments of a mode-directed tabled predicate to be unbound.

  397mode_check(Moded, Check) :-
  398    var(Moded),
  399    !,
  400    Check = (var(Moded)->true;'$uninstantiation_error'(Moded)).
  401mode_check(Moded, true) :-
  402    '$tbl_trienode'(Moded),
  403    !.
  404mode_check(Moded, (Test->true;'$tabling':instantiated_moded_arg(Vars))) :-
  405    Moded =.. [s|Vars],
  406    var_check(Vars, Test).
  407
  408var_check([H|T], Test) :-
  409    (   T == []
  410    ->  Test = var(H)
  411    ;   Test = (var(H),Rest),
  412        var_check(T, Rest)
  413    ).
  414
  415:- public
  416    instantiated_moded_arg/1.  417
  418instantiated_moded_arg(Vars) :-
  419    '$member'(V, Vars),
  420    \+ var(V),
  421    '$uninstantiation_error'(V).

 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,...)

  433extract_modes(ModeSpec, Head, Variant, Modes, ModedAnswer) :-
  434    compound_name_arguments(ModeSpec, Name, ModeSpecArgs),
  435    compound_name_arguments(Head, Name, HeadArgs),
  436    separate_args(ModeSpecArgs, HeadArgs, VariantArgs, Modes, ModedArgs),
  437    length(ModedArgs, Count),
  438    atomic_list_concat([$,Name,$,Count], VName),
  439    Variant =.. [VName|VariantArgs],
  440    (   ModedArgs == []
  441    ->  '$tbl_trienode'(ModedAnswer)
  442    ;   ModedArgs = [ModedAnswer]
  443    ->  true
  444    ;   ModedAnswer =.. [s|ModedArgs]
  445    ).

 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?

  455separate_args([], [], [], [], []).
  456separate_args([HM|TM], [H|TA], [H|TNA], Modes, TMA):-
  457    indexed_mode(HM),
  458    !,
  459    separate_args(TM, TA, TNA, Modes, TMA).
  460separate_args([M|TM], [H|TA], TNA, [M|Modes], [H|TMA]):-
  461    separate_args(TM, TA, TNA, Modes, TMA).
  462
  463indexed_mode(Mode) :-                           % XSB
  464    var(Mode),
  465    !.
  466indexed_mode(index).                            % YAP
  467indexed_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.

  474updater_clauses([], _, []) :- !.
  475updater_clauses([P], Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :- !,
  476    update_goal(P, S0,S1,S2, Body).
  477updater_clauses(Modes, Head, [('$table_update'(Head, S0, S1, S2) :- Body)]) :-
  478    length(Modes, Len),
  479    functor(S0, s, Len),
  480    functor(S1, s, Len),
  481    functor(S2, s, Len),
  482    S0 =.. [_|Args0],
  483    S1 =.. [_|Args1],
  484    S2 =.. [_|Args2],
  485    update_body(Modes, Args0, Args1, Args2, true, Body).
  486
  487update_body([], _, _, _, Body, Body).
  488update_body([P|TM], [A0|Args0], [A1|Args1], [A2|Args2], Body0, Body) :-
  489    update_goal(P, A0,A1,A2, Goal),
  490    mkconj(Body0, Goal, Body1),
  491    update_body(TM, Args0, Args1, Args2, Body1, Body).
  492
  493update_goal(Var, _,_,_, _) :-
  494    var(Var),
  495    !,
  496    '$instantiation_error'(Var).
  497update_goal(lattice(M:PI), S0,S1,S2, M:Goal) :-
  498    !,
  499    '$must_be'(atom, M),
  500    update_goal(lattice(PI), S0,S1,S2, Goal).
  501update_goal(lattice(Name/Arity), S0,S1,S2, Goal) :-
  502    !,
  503    '$must_be'(oneof(integer, lattice_arity, [3]), Arity),
  504    '$must_be'(atom, Name),
  505    Goal =.. [Name,S0,S1,S2].
  506update_goal(lattice(Name), S0,S1,S2, Goal) :-
  507    !,
  508    '$must_be'(atom, Name),
  509    update_goal(lattice(Name/3), S0,S1,S2, Goal).
  510update_goal(po(Name/Arity), S0,S1,S2, Goal) :-
  511    !,
  512    '$must_be'(oneof(integer, po_arity, [2]), Arity),
  513    '$must_be'(atom, Name),
  514    Call =.. [Name, S0, S1],
  515    Goal = (Call -> S2 = S0 ; S2 = S1).
  516update_goal(po(M:Name/Arity), S0,S1,S2, Goal) :-
  517    !,
  518    '$must_be'(atom, M),
  519    '$must_be'(oneof(integer, po_arity, [2]), Arity),
  520    '$must_be'(atom, Name),
  521    Call =.. [Name, S0, S1],
  522    Goal = (M:Call -> S2 = S0 ; S2 = S1).
  523update_goal(po(M:Name), S0,S1,S2, Goal) :-
  524    !,
  525    '$must_be'(atom, M),
  526    '$must_be'(atom, Name),
  527    update_goal(po(M:Name/2), S0,S1,S2, Goal).
  528update_goal(po(Name), S0,S1,S2, Goal) :-
  529    !,
  530    '$must_be'(atom, Name),
  531    update_goal(po(Name/2), S0,S1,S2, Goal).
  532update_goal(Alias, S0,S1,S2, Goal) :-
  533    update_alias(Alias, Update),
  534    !,
  535    update_goal(Update, S0,S1,S2, Goal).
  536update_goal(Mode, _,_,_, _) :-
  537    '$domain_error'(tabled_mode, Mode).
  538
  539update_alias(first, lattice('$tabling':first/3)).
  540update_alias(-,     lattice('$tabling':first/3)).
  541update_alias(last,  lattice('$tabling':last/3)).
  542update_alias(min,   lattice('$tabling':min/3)).
  543update_alias(max,   lattice('$tabling':max/3)).
  544update_alias(sum,   lattice('$tabling':sum/3)).
  545
  546mkconj(true, G,  G) :- !.
  547mkconj(G1,   G2, (G1,G2)).
  548
  549
  550		 /*******************************
  551		 *          AGGREGATION		*
  552		 *******************************/

 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.

  562:- public first/3, last/3, min/3, max/3, sum/3.  563
  564first(S, _, S).
  565last(_, S, S).
  566min(S0, S1, S) :- (S0 @< S1 -> S = S0 ; S = S1).
  567max(S0, S1, S) :- (S0 @> S1 -> S = S0 ; S = S1).
  568sum(S0, S1, S) :- S is S0+S1.
  569
  570
  571		 /*******************************
  572		 *         RENAME WORKER	*
  573		 *******************************/

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

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

  580prolog:rename_predicate(M:Head0, M:Head) :-
  581    '$flushed_predicate'(M:'$tabled'(_)),
  582    call(M:'$tabled'(Head0)),
  583    \+ current_prolog_flag(xref, true),
  584    !,
  585    rename_term(Head0, Head).
  586
  587rename_term(Compound0, Compound) :-
  588    compound(Compound0),
  589    !,
  590    compound_name_arguments(Compound0, Name, Args),
  591    atom_concat(Name, ' tabled', WrapName),
  592    compound_name_arguments(Compound, WrapName, Args).
  593rename_term(Name, WrapName) :-
  594    atom_concat(Name, ' tabled', WrapName).
  595
  596
  597system:term_expansion((:- table(Preds)),
  598                      [ (:- multifile('$tabled'/1)),
  599                        (:- multifile('$table_mode'/3)),
  600                        (:- multifile('$table_update'/4))
  601                      | Clauses
  602                      ]) :-
  603    \+ current_prolog_flag(xref, true),
  604    phrase(wrappers(Preds), Clauses)