1/*  Part of SWI-Prolog
   2
   3    Author:        Benoit Desouter <Benoit.Desouter@UGent.be>
   4                   Jan Wielemaker (SWI-Prolog port)
   5    Copyright (c)  2016, Benoit Desouter
   6    All rights reserved.
   7
   8    Redistribution and use in source and binary forms, with or without
   9    modification, are permitted provided that the following conditions
  10    are met:
  11
  12    1. Redistributions of source code must retain the above copyright
  13       notice, this list of conditions and the following disclaimer.
  14
  15    2. Redistributions in binary form must reproduce the above copyright
  16       notice, this list of conditions and the following disclaimer in
  17       the documentation and/or other materials provided with the
  18       distribution.
  19
  20    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  21    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  22    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  23    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  24    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  25    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  26    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  27    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  28    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  29    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  30    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  31    POSSIBILITY OF SUCH DAMAGE.
  32*/
  33
  34:- module(tabling,
  35          [ (table)/1,                  % +PI ...
  36
  37            current_table/2,            % :Variant, ?Table
  38            abolish_all_tables/0,
  39            abolish_table_subgoals/1,   % :Subgoal
  40
  41            start_tabling/2,            % +Wrapper, :Worker.
  42
  43            op(1150, fx, table)
  44          ]).
  45:- use_module(library(error)).
  46:- set_prolog_flag(generate_debug_info, false).
  47
  48:- meta_predicate
  49    start_tabling(+, 0),
  50    current_table(:, -),
  51    abolish_table_subgoals(:).
  52
  53/** <module> Tabled execution (SLG WAM)
  54
  55This  library  handled  _tabled_  execution   of  predicates  using  the
  56characteristics if the _SLG WAM_. The required suspension is is realised
  57using _delimited continuations_ implemented by  reset/3 and shift/1. The
  58table space and work lists are part of the SWI-Prolog core.
  59
  60@author Benoit Desouter
  61*/
  62
  63%!  table(+PredicateIndicators)
  64%
  65%   Prepare the given PredicateIndicators for   tabling. Can only be
  66%   used as a directive. The example   below  prepares the predicate
  67%   edge/2 and the non-terminal statement//1 for tabled execution.
  68%
  69%     ==
  70%     :- table edge/2, statement//1.
  71%     ==
  72
  73table(PIList) :-
  74    throw(error(context_error(nodirective, table(PIList)), _)).
  75
  76%!  start_tabling(+Variant, +Implementation)
  77%
  78%   Execute Implementation using tabling. This  predicate should not
  79%   be called directly. The table/1 directive  causes a predicate to
  80%   be translated into a renamed implementation   and a wrapper that
  81%   involves this predicate.
  82%
  83%   @compat This interface may change or disappear without notice
  84%           from future versions.
  85
  86start_tabling(Wrapper,Worker) :-
  87    '$tbl_variant_table'(Wrapper, Trie, Status),
  88    (   Status == complete
  89    ->  trie_gen(Trie, Wrapper, _)
  90    ;   (   '$tbl_scheduling_component'(false, true)
  91        ->  catch(run_leader(Wrapper, Worker, Trie), E, true),
  92            (   var(E)
  93            ->  trie_gen(Trie, Wrapper, _)
  94            ;   '$tbl_table_discard_all',
  95                throw(E)
  96            )
  97        ;   run_follower(Status, Wrapper, Worker, Trie)
  98        )
  99    ).
 100
 101run_follower(fresh, Wrapper, Worker, Trie) :-
 102    !,
 103    activate(Wrapper, Worker, Trie, Worklist),
 104    shift(call_info(Wrapper, Worklist)).
 105run_follower(Worklist, Wrapper, _Worker, _Trie) :-
 106    shift(call_info(Wrapper, Worklist)).
 107
 108run_leader(Wrapper, Worker, Trie) :-
 109    activate(Wrapper, Worker, Trie, _Worklist),
 110    completion,
 111    '$tbl_scheduling_component'(_, false).
 112
 113activate(Wrapper, Worker, Trie, WorkList) :-
 114    '$tbl_new_worklist'(WorkList, Trie),
 115    (   delim(Wrapper, Worker, WorkList),
 116        fail
 117    ;   true
 118    ).
 119
 120delim(Wrapper, Worker, WorkList) :-
 121    reset(Worker,SourceCall,Continuation),
 122    (   Continuation == 0
 123    ->  '$tbl_wkl_add_answer'(WorkList, Wrapper)
 124    ;   SourceCall = call_info(SrcWrapper, SourceWL),
 125        TargetCall = call_info(Wrapper,    WorkList),
 126        Dependency = dependency(SrcWrapper,Continuation,TargetCall),
 127        '$tbl_wkl_add_suspension'(SourceWL, Dependency)
 128    ).
 129
 130completion :-
 131    '$tbl_pop_worklist'(WorkList),
 132    !,
 133    completion_step(WorkList),
 134    completion.
 135completion :-
 136    '$tbl_table_complete_all'.
 137
 138completion_step(SourceTable) :-
 139    (   '$tbl_wkl_work'(SourceTable, Answer, Dependency),
 140        dep(Answer, Dependency, Wrapper,Continuation,TargetTable),
 141        delim(Wrapper,Continuation,TargetTable),
 142        fail
 143    ;   true
 144    ).
 145
 146dep(Answer, dependency(Answer, Continuation, call_info(Wrapper, TargetTable)),
 147    Wrapper, Continuation,TargetTable).
 148
 149
 150                 /*******************************
 151                 *            CLEANUP           *
 152                 *******************************/
 153
 154%!  abolish_all_tables
 155%
 156%   Remove all tables. This is normally used to free up the space or
 157%   recompute the result after predicates on   which  the result for
 158%   some tabled predicates depend.
 159%
 160%   @error  permission_error(abolish, table, all) if tabling is
 161%           in progress.
 162
 163abolish_all_tables :-
 164    '$tbl_abolish_all_tables'.
 165
 166%!  abolish_table_subgoals(:Subgoal) is det.
 167%
 168%   Abolish all tables that unify with SubGoal.
 169
 170abolish_table_subgoals(M:SubGoal) :-
 171    '$tbl_variant_table'(VariantTrie),
 172    current_module(M),
 173    forall(trie_gen(VariantTrie, M:SubGoal, Trie),
 174           '$tbl_destroy_table'(Trie)).
 175
 176
 177                 /*******************************
 178                 *        EXAMINE TABLES        *
 179                 *******************************/
 180
 181%!  current_table(:Variant, -Trie) is nondet.
 182%
 183%   True when Trie is the answer table for Variant.
 184
 185current_table(M:Variant, Trie) :-
 186    '$tbl_variant_table'(VariantTrie),
 187    (   (var(Variant) ; var(M))
 188    ->  trie_gen(VariantTrie, M:Variant, Trie)
 189    ;   trie_lookup(VariantTrie, M:Variant, Trie)
 190    ).
 191
 192
 193                 /*******************************
 194                 *      WRAPPER GENERATION      *
 195                 *******************************/
 196
 197:- multifile
 198    system:term_expansion/2,
 199    prolog:rename_predicate/2,
 200    tabled/2.
 201:- dynamic
 202    system:term_expansion/2.
 203
 204wrappers(Var) -->
 205    { var(Var),
 206      !,
 207      instantiation_error(Var)
 208    }.
 209wrappers((A,B)) -->
 210    !,
 211    wrappers(A),
 212    wrappers(B).
 213wrappers(Name//Arity) -->
 214    { atom(Name), integer(Arity), Arity >= 0,
 215      !,
 216      Arity1 is Arity+2
 217    },
 218    wrappers(Name/Arity1).
 219wrappers(Name/Arity) -->
 220    { atom(Name), integer(Arity), Arity >= 0,
 221      !,
 222      functor(Head, Name, Arity),
 223      atom_concat(Name, ' tabled', WrapName),
 224      Head =.. [Name|Args],
 225      WrappedHead =.. [WrapName|Args],
 226      prolog_load_context(module, Module)
 227    },
 228    [ '$tabled'(Head),
 229      (   Head :-
 230             start_tabling(Module:Head, WrappedHead)
 231      )
 232    ].
 233
 234%!  prolog:rename_predicate(:Head0, :Head) is semidet.
 235%
 236%   Hook into term_expansion for  post   processing  renaming of the
 237%   generated predicate.
 238
 239prolog:rename_predicate(M:Head0, M:Head) :-
 240    '$flushed_predicate'(M:'$tabled'(_)),
 241    call(M:'$tabled'(Head0)),
 242    !,
 243    rename_term(Head0, Head).
 244
 245rename_term(Compound0, Compound) :-
 246    compound(Compound0),
 247    !,
 248    compound_name_arguments(Compound0, Name, Args),
 249    atom_concat(Name, ' tabled', WrapName),
 250    compound_name_arguments(Compound, WrapName, Args).
 251rename_term(Name, WrapName) :-
 252    atom_concat(Name, ' tabled', WrapName).
 253
 254
 255system:term_expansion((:- table(Preds)),
 256                      [ (:- discontiguous('$tabled'/1))
 257                      | Clauses
 258                      ]) :-
 259    phrase(wrappers(Preds), Clauses).
 260
 261
 262                 /*******************************
 263                 *           SANDBOX            *
 264                 *******************************/
 265
 266:- multifile
 267    sandbox:safe_directive/1,
 268    sandbox:safe_primitive/1,
 269    sandbox:safe_meta/2.
 270
 271%!  sandbox:safe_directive(+Directive) is semidet.
 272%
 273%   Allow tabling directives that affect locally defined predicates.
 274
 275sandbox:safe_directive(Dir) :-
 276    ground(Dir),
 277    local_tabling_dir(Dir).
 278
 279local_tabling_dir(table(Preds)) :-
 280    local_preds(Preds).
 281
 282local_preds((A,B)) :-
 283    !,
 284    local_preds(A),
 285    local_preds(B).
 286
 287local_preds(Name/Arity) :-
 288    atom(Name), integer(Arity).
 289local_preds(Name//Arity) :-
 290    atom(Name), integer(Arity).
 291
 292sandbox:safe_meta_predicate(tabling:start_tabling/2).
 293
 294sandbox:safe_primitive(tabling:abolish_all_tables).
 295sandbox:safe_meta(tabling:abolish_table_subgoals(V), []) :-
 296    \+ qualified(V).
 297sandbox:safe_meta(tabling:current_table(V, _), []) :-
 298    \+ qualified(V).
 299
 300qualified(V) :-
 301    nonvar(V),
 302    V = _:_.