1/*  Part of SWI-Prolog
    2
    3    Author:        Douglas R. Miles
    4    E-mail:        logicmoo@gmail.com
    5    WWW:           http://www.swi-prolog.org http://www.prologmoo.com
    6    Copyright (C): 2015, University of Amsterdam
    7                                    VU University Amsterdam
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29
   30*/
   31
   32 
   33   % NOTICE: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   34   %                                                                      %
   35   %  COPYRIGHT (2009) University of Dallas at Texas.                     %
   36   %                                                                      %
   37   %  Developed at the Applied Logic, Programming Languages and Systems   %
   38   %  (ALPS) Laboratory at UTD by Feliks Kluzniak.                        %
   39   %                                                                      %
   40   %  Permission is granted to modify this file, and to distribute its    %
   41   %  original or modified contents for non-commercial purposes, on the   %
   42   %  condition that this notice is included in all copies in its         %
   43   %  original form.                                                      %
   44   %                                                                      %
   45   %  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,     %
   46   %  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES     %
   47   %  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE AND     %
   48   %  NON-INFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR        %
   49   %  ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE FOR ANY DAMAGES OR       %
   50   %  OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, ARISING    %
   51   %  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR       %
   52   %  OTHER DEALINGS IN THE SOFTWARE.                                     %
   53   %                                                                      %
   54   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   55
   56:-module('$dra',[
   57          dra_call_interp/1,
   58          dra_call_tabled/1,
   59          dra_call_coind0/1,
   60          dra_call_coind1/1,
   61					essence_hook/2,
   62          get_all_tabled_goals/1,
   63          cont_dra_call/0,
   64          exit_dra_call/0,
   65          init_dra_call/0,
   66          process_dra_ective/1,
   67					(table)/1,
   68				  (coinductive0)/1,
   69				  (coinductive1)/1,
   70          (tnot)/1,
   71          initialize_table/0,
   72				  abolish_tables/0,
   73          print_tables/0,
   74
   75
   76          op( 1010, fy, 'table'  ),    % allow  " table p/k ,"
   77          op( 1010, fy, 'old_first'  ),    % allow  " old_first p/k ,"
   78          op( 1010, fy, 'never_table'  ),    % allow  " traces  p/k ,"
   79          op( 1010, fy, 'coinductive0'  ),    % allow  " coinductive0 p/k ,"
   80          op( 1010, fy, 'coinductive1' ),    % allow  " coinductive1 p/k ,"
   81          op( 1010, fy, 'hilog'   ),    % allow  " hilog  p/k ,"
   82          op( 910,  fy, 'tnot'  )    % allow  "?- tnot  p(_) ,"
   83]).
BEGIN README.md
General description -------------------
A simple (and very inefficient) interpreter that emulates "top-down tabled programming", as described in
[1] Hai-Feng Guo, Gopal Gupta: Tabled Logic Programming with Dynamic Ordering of Alternatives (17th ICLP, 2001)
There are two significant changes with respect to the description in the paper:

The terminology has been modified under the influence of

[2] Neng-Fa Zhou, Taisuke Sato, Yi-Dong Shen: Linear Tabling Strategies and Optimizations (TPLP 2008 (?))
More specifically, "masters" are called "pioneers" (although in a sense somewhat different than in [2]: we use "pioneer" for "topmost looping goal"), and "strongly connected components" are called "clusters".
Note that "clusters" are detected dynamically, to achieve greater precision (a dependency graph among static calls can only be a rough approximation, a dependency graph among predicates is rougher still).
Nomenclature ------------
Some predicates are "tabled", because the user has declared them to be such by using an appropriate directive, e.g.,
:-table p/2 .
All calls to a tabled predicate that are present in the interpreted program are called "tabled calls". Instances of such calls are called "tabled goals". In general, we will use the term "call" to refer to a static entity in the program, and "goal" to refer to an instance of a call. We will also avoid the conventional overloading of the term "goal" in yet another way: we will call a sequence (i.e., conjunction) of goals just that (unless we can refer to it as a "query" or a "resolvent").
Similarly, the user can declare a predicate to be "coinductive", by using another kind of directive, e.g.,
:-coinductive0  p/2 .
:-coinductive1 q/3 .
Calls and goals that refer to a coinductive predicate will also be called "coinductive".
Old Limitations -----------

The OLD interpreted program could not contain cuts. This version might be able to.

NOTEs: -----------
  1. :- use_module(library(dra)).
  2. The interpreter supports a number of directives:
    a) Tabled and coinductive predicates should be declared as such in the program file, e.g., :-table ancestor/2. :-coinductive0 comember/2. :-coinductive1 comember/2.
    "coinductive1" means that if there are coinductive hypotheses with which a goal unifies, then the usual clauses will not be tried after the hypotheses are exhausted (this is "new style" coinduction).
    b) To include files use the usual Prolog syntax: :-[ file1, file2, ... ].
    c) To declare predicates used in an interpreted program as dynamic, use :-dynamic p/k.
    d) By default, a goal produces new (i.e., heretofore unknown) answers before producing old ones. To reverse this behaviour, use
    :-old_first p/k.
    or :-old_first all.

    e) To produce a wallpaper traces use the traces directive. For example,

    :-traces p/3, q/0, r/1.
    will traces predicates "p/3", "q/0" and "r/1". If you want to traces everything, use
    :-traces all.

    These directives are cumulative.

    f) To print out subsets of the current answer table, use

    :-answers( Goal, Pattern ).
    this will print all tabled answers that are associated with a variant of Goal and unifiable with Pattern. To get a dump of the entire table, use just
    :-answers( _, _ ).
  3. The program should contain no other directives. It may, however, contain queries, which will be executed immediately upon reading.
  4. Just before the result of a query is reported, the interpreter produces a printout with statistics accummulated since the previous printout (or since the beginning, if this is the first printout during this session with the interpreted program). The printout looks like this:
    [K steps, M new answers tabled (N in all)]

    where K, M and N are some natural numbers. K is the number of evaluated goals, M is the number of new additions to the answer table, N is the current size of the answer table.

  5. If the program invokes a built-in predicate, that predicate must be declared in the table "is_never_tabled/1" (see file "dra_builtins.pl"). Every addition should be considered carefully: some built-ins might require special treatment by the interpreter.
  6. The program may contain clauses that modify the definition of the interpreter''s predicate "essence_hook/2" (the clauses will be asserted at the front of the predicate, and will thus override the default definition for some cases). The default definition is

    essence_hook( T, T ).

    This predicate is invoked in certain contexts when:

    • two terms are about to be compared (either for equality or to check whether they are variants of each other);
    • an answer is tabled;
    • an answer is retrieved from the table.

    The primary intended use is to suppress arguments that carry only administrative information and that may differ in two terms that are "semantically" equal or variants of each other. (Such, for example, is the argument that carries the set of coinductive hypotheses in a co-logic program translated into Prolog: see "../coind/translate_clp". Mind you, that translation need not be applied to programs executed by this interpreter).

    For example, the presence of

    essence_hook( p( A, B, _ ), p( A, B ) ).

    will result in "p( a, b, c )" and "p( a, b, d )" being treated as identical, as each of them will be translated to "p( a, b )" before comparison.

    NOTE: This facility should be used with the utmost caution, as it may drastically affect the semantics of the interpreted program in a fashion that would be hard to understand for someone who does not understand the details of the interpreter.
    The top level notes "never_tabled" declarations in the table "is_never_tabled". For example,
    :-never_tabled p/1, q/2.

    will be stored as

    is_never_tabled( p( _ ) ).
    is_never_tabled( q( _, _ ) ).
    The intended meaning is that "never_tabled" predicates do not make use (directly or indirectly) of the special features provided by the metainterpreter, so their invocations can be handled just by handing them over to Prolog (which would presumably speed up the computation).
    The metainterpreter should provide the following predicates ("hooks") that will be called by the top level:
    • is_cut_ok/1:
      Defines patterns for built-in predicates from the host system that can may contain cuts without damaging semantics. For example, to allow dra_w/2, declare: :- is_cut_ok( dra_w( _, _ ) ).
    • initialize_table/0:
      This will be called before loading a new program, giving the metainterpreter an opportunity to (re)initialize_table its data structures.
    • legal_directive/1:
      Whenever the top level encounters a directive (of the form ":-D."), it will call "legal_directive( D )". If the call succeeds, the interpreter will be given a chance to process the directive (see below), otherwise the directive will be ignored (with a suitable warning).
    • process_dra_ective/1:
      Whenever the top level encounters a legal directive ":-D" (see above), it invokes "process_dra_ective( D )" to give the interpreter a chance to act upon the directive.
    • dra_call_interp/1:
      This would be the main entry point of the metainterpreter. Whenever the top level encounters a query (of the form "?- Q."), it will display the query and then call "dra_call_interp( Q )". Depending on the result, it will then display "No", or "Yes" (preceded by a display of bindings acquired by the variables occurring in "Q"); in the latter case it will also backtrack to obtain more solutions.

END README.md

Data structures ---------------
The interpreter uses a number of tables that store information accumulated during a computation. A computation consists in reading a program and executing a number of queries. A query is a sequence (i.e., conjunction) of goals.

The tables (implemented as dynamic predicates of Prolog) are:

-- is_tabled( generic head ) -- is_coinductive0( generic head ) -- is_coinductive1( generic head ) -- is_old_first( generic head )
Each of these tables contains an entry for each predicate that has been declared as having the corresponding property (i.e., as coinductive, table etc.). For instance, when the interpreter reads :-coinductive0 p/2 . it stores the fact is_coinductive0( p( _, _ ) ).
A "coinductive0" declaration is deemed to supersede "coinductive1", and information about a predicate that has been so declared is stored both in coinductive0/1 and coinductive1/1.

These tables are cleared only before reading in a new program.

-- answer( goal, fact )

Used to store results computed for tabled goals encountered during a
computation.  Once present, these results are also used during
further stages of the computation.

Note that the fact is an instantiation of the goal.  If a tabled goal
has no solutions, it will have no entry in "answer", even though it
may have an entry in "completed" (see below).

(NOTE:
    1. In the actual implementation each fact in "answer" has the
       form
          answer( cgoal, goal, fact )
       where "cgoal" is a copy of "goal" (no shared variables),
       passed through essence_hook/2.
       This is done to facilitate more effective filtering (via
       unification) before a check is made for whether "goal" is a
       variant of the goal for which we are seeking a tabled answer.
  1. This stuff has been removed to file dra_table_assert.pl or dra_table_record.pl (only one of them is used, depending on the logic programming see the main file used to load the program. ))

This table is not cleared before the evaluation of a new query.

Detailed comments: .................. In general, for each success of a tabled goal encountered during the evaluation of a query, the interpreter will make certain that the result, i.e., the successful instantiation of that goal (which need not be ground!) is stored in the table "answer", accompanied by a variant of the original version of the goal (i.e., as it appeared when it was first encountered).
Before a query finally fails (after exhausting all the answers), tabled goals encountered during its evaluation will have computed their least fixed points, i.e., all the possible results for those goals will be stored in "answer". (Of course, if this set of all answers is not sufficiently small, the interpreter will not terminate successfully.)
Results stored in "answer" can be picked up during later evaluation but each of them is valid only for a variant of the accompanying goal.
The need for associating a fact with information about the corresponding goal might not be immediately obvious. Consider the following example (which is simplistic in that the computation itself is trivial):
program:  :-table p/2.
          p( A, A ).
          p( a, b ).

queries:  ?-  p( U, V ).
          ?-  p( Y, b ).
During "normal" execution of this Prolog program each of the queries would generate a different set of results; to wit:
p( U, V )  would generate  p( U, U ), p( a, b );
p( Y, b )  ..............  p( b, b ), p( a, b ).
In other words, the set of results depends not only on the predicate, but also on the form of the goal.
If these results were tabled without the corresponding goals, then the table would be:
answer( p( U, U ) ).
answer( p( a, b ) ).
answer( p( b, b ) ).
A subsequent invocation of p( U, V ) would then return all three results, i.e., also "p( b, b )"!
The proper contents of "answer" should be as follows (though not necessarily in this order):
answer( p( U, V ), p( U, U ) ).
answer( p( U, V ), p( a, b ) ).
answer( p( Y, b ), p( b, b ) ).
answer( p( Y, b ), p( a, b ) ).
Please note that two different entries in "answer" will not be variants of each other.

-- pioneer( goal, index )

If the current goal is tabled, and it is not a variant of any of its
ancestors, then the goal is called a "pioneer" and obtains an "index"
(i.e., an unique identifier). Both the goal and its index are
recorded in this table.

The role of a pioneer is to compute the fixpoint (by tabling answers)
 for itself and its cluster before failing: this is why the results
for its variant descendants can be obtained simply by dra_calling
"answer", without using their clauses (which prevents endless
recursion).

If a pioneer is later determined not to be the "topmost looping goal"
in a "cluster" of interdependent goals (see ref. [2]), then it loses
the status of a pioneer, and its role will be overtaken by the
topmost goal in the cluster.  (This can happen if one of the
descendants of a pioneer turns out to be a variant of one of its
ancestors.)

A pioneer also loses its status if its fixpoint has been computed: it
then becomes a "completed" goal (and all its variants become
completed).

A pioneer "G" may also lose its status because another goal "G'",
encountered after "G" succeeds without yet becoming completed, has
become completed: if "G'" is a variant of "G", thne "G" becomes
completed as well.

When a pioneer loses its status, the associated entries in "pioneer",
"loop" and "looping_alternative" (see below) are removed.  The
associated entries in "result" are not removed. The unique index is
not reused for other goals during the evaluation of the current
query.

This table is cleared before the evaluation of a new query.

(NOTE: In the actual implementation each fact in "pioneer" has the
       form
          pioneer( cgoal, goal, index )
       where "cgoal" is a copy of "goal" (no shared variables),
       passed through essence_hook/2.
       This is done to facilitate more effective filtering (via
       unification) before a check is made for whether "goal" is a
       variant of the goal for which we are checking whether it is
       (still) a pioneer.
)

-- unique_index

This is a non-logical variable that holds the index to be used for
the next entry in "pioneer".  It is also used to generate unique
indices for coinductive goals, which might need them to hold their
own results in "result".

The variable is cleared before the evaluation of a new query.

-- result( index, fact )

A tabled goal "G" that "started out" as a pioneer may have associated
entries (marked with the unique index of "G") in "result".  This
table records the instantiations of "G" that were returned as "G"
succeeded.  By using the table, the interpreter prevents "G" from
returning the same answer over and over again: in general, each
tabled goal will not produce two results that are variants of each
other.

When a goal loses its pioneer status (because it is determined to be
a part of a larger loop, or because it has become completed), the
associated entries in "result" are not removed.  They are removed
only when the goal finally fails.

The table is also used by coinductive goals that are not pioneers.

This table is cleared before the evaluation of a new query.

-- loop( index, list of goals )

A loop is discovered when the current tabled goal is a variant of one
of its ancestors.  If the ancestor is a pioneer, the unique index of
the pioneer ancestor and a list of the tabled goals between the
pioneer and the variant are stored in "loop".

A number of "loop" entries may exist for a given pioneer: together,
they describe a "cluster" (i.e., a "strongly connected component",
see ref. [1]).  Before finally failing upon backtracking, a pioneer
will compute its own fixpoint as well as the fixpoints of the goals
in its cluster.

When a goal loses its pioneer status (because it is determined to be
a part of a larger loop, or because it has become completed), the
associated entries in "loop" are removed.

This table is cleared before the evaluation of a new query.

-- looping_alternative( index, clause )

When a goal "G" is determined to be a variant descendant of a
pioneer, the clause that is currently being used by the pioneer
(i.e., the clause that led to "G") is stored in this table, together
with the unique index of the pioneer.  "G" will then succeed only
with answers that have been tabled so far, but the clause will be
used again as backtracking brings the computation back to the
pioneer.  (This is the essence of the "dynamic reordering of
alternatives".
 )

When a goal loses its pioneer status (because it is determined to be
a part of a larger loop, or because it has become completed), the
associated entries in "looping_alternative" are removed.

This table is cleared before the evaluation of a new query.

-- completed( goal )

Indicates that this tabled goal is completed, i.e., its fixpoint has
been computed, and all the possible results for variants of the goal
can be found in table "answer".  Variants of a completed goal are
completed as well.

This table is not cleared before the evaluation of a new query.

(NOTE: In the actual implementation each fact in "completed" has the
       form
          completed( cgoal, goal )
       where "cgoal" is a copy of "goal" (no shared variables),
       passed through essence_hook/2.
       This is done to facilitate more effective filtering (via
       unification) before a check is made for whether "goal" is a
       variant of the goal for which we are checking whether it is
       completed.
)

-- number_of_answers

This is a no-profiling heuristics variable that records the size of "answer".  It
is useful for determining whether new answers have been generated
during a phase of the computation.

This variable is not cleared before the evaluation of a new query.
Profiling below is not part of the tabling system -----------------------------------------------------

-- is_traced( goal )

A goal that matches something in this table will show up on the
wallpaper traces.  This table is empty by default, and filled only
by invocations of "traces" (most often in "traces" directives
encountered when the interpreted program is being read).

-- step_counter

This is a profiling non-logical variable that keeps track of the number of goals resolved during the evaluation of each query. The final value is printed after the query terminates.

The variable is cleared before the evaluation of a new query.

-- old_table_size

This is a profiling non-logical variable that is used to store the value of
"number_of_answers" before the evaluation of a query.  Used to
produce automatic information about the growth of the table after the
query terminates.

The variable is reinitialized before the evaluation of a new query.

*/

  630% :-shell(cls).
  631:-'$set_source_module'(_,'$dra').  632:-dynamic(was_access_level/1).  633:-current_prolog_flag(access_level,Was),asserta(was_access_level(Was)).  634:-set_prolog_flag(access_level,user).  635:-meta_predicate dra_asserta_new(:).  636:-meta_predicate dra_retract_all(:).  637:-meta_predicate dra_must(0).  638
  639:- if(\+ current_predicate(system:'$exit_dra'/0)).  640
  641system:'$exit_dra'.
  642system:'$enter_dra'.
  643
  644:- endif.  645
  646
  647std_trace_stream(user_error).
  648dra_w(M):-std_trace_stream(S),format(S,'~q',[M]),flush_output(S).
  649dra_wln(M):-call(notrace,((current_predicate(logicmoo_util_dmsg:dmsg/1),!,logicmoo_util_dmsg:dmsg(M)))),!.
  650dra_wln(M):-std_trace_stream(S),format(S,'~q.~n',[M]),flush_output(S).
  651dra_retract_all(R):-ignore((retract(R),fail)).
  652% dra_asserta_new(G):-catch(G,_,fail),!.
  653dra_asserta_new(G):-dra_retract_all(G),asserta(G).
  654dra_assertz_new(G):-dra_retract_all(G),assertz(G).
  655dra_must((G1,G2)):- !, dra_must(G1),dra_must(G2).
  656dra_must(G):-G *->true;dra_error(failed_dra_must(G)).
  657dra_error(W):-throw(dra_error(W)).
  658
  659% BREAKS THINGS :- meta_predicate(add_clauses(:,0)).
  660:- module_transparent(add_clauses/2).  661add_clauses(_,_):- current_prolog_flag(xref, true),!.
  662add_clauses(H,B):- predicate_property(H,dynamic),!,dra_asserta_new((H:-B)).
  663add_clauses(H,B):- predicate_property(H,number_of_clauses(_)), ( \+ \+ clause(H,B)),!.
  664add_clauses(H,B):- predicate_property(H,static),!,directive_source_file(File),'$compile_aux_clauses'([(H:-B)], File).
  665add_clauses(H,B):- predicate_property(H,undefined), \+ source_location(_,_), !,dra_asserta_new((H:-B)).
  666add_clauses(H,B):- directive_source_file(File),'$compile_aux_clauses'([(H:-B)], File).
  667
  668directive_source_file(File):-prolog_load_context(source,File),!.
  669directive_source_file(File):-prolog_load_context(module,File),!.
  670
  671property_pred((table),is_tabled).
  672property_pred(coinductive0,is_coinductive0).
  673property_pred(coinductive1,is_coinductive1).
  674property_pred((traces),is_traced).
  675property_pred(cut_ok,is_cut_ok).
  676property_pred(old_first,is_old_first).
  677property_pred(never_tabled,is_never_tabled).
  678property_pred(hilog,is_hilog).
  679property_pred(topl,is_topl).
  680
  681table(Mask):- process_dra_ective(table(Mask)).
  682coinductive0(Mask):-process_dra_ective(coinductive0(Mask)).
  683coinductive1(Mask):-process_dra_ective(coinductive1(Mask)).
  684topl(Mask):-process_dra_ective(topl(Mask)).
  685
  686make_db_pred(D,F):-
  687    DG=..[D,_],
  688    (predicate_property(M:DG,_)->true;(predicate_property(DG,imported_from(M))->true;M=system)),
  689    module_transparent(M:DG), add_clauses(M:DG , process_dra_ective(DG)), 
  690   ( \+ current_op(_,fy,user:D) -> op(1010,fy,user:D) ; true),
  691    dynamic(F/1),
  692    multifile(F/1).
  693
  694:-forall(property_pred(D,F) , make_db_pred(D,F)).  695
  696% ON :-initialization( profiler(_,walltime) ).
  697% ON :-initialization(user:use_module(library(swi/pce_profile))).
  698
  699% :-multifile sandbox:safe_primitive/1.
  700% :-asserta((sandbox:safe_primitive(Z):-wdmsg(Z))).
  701% :-user:ensure_loaded(library(ape/get_ape_results)).
  702% :-user:ensure_loaded(library(logicmoo/util/logicmoo_util_all)).
  703
  704
  705
  706% BREAKS THINGS meta_predicate(set_meta(0,+)).
  707:- module_transparent(set_meta/2).  708
  709
  710/*
  711set_meta(TGoal,is_coinductive0):- !,
  712    functor(TGoal,F,A),
  713    use_module(library(coinduction),[ (coinductive)/1,op(1150, fx, (coinductive))]),
  714    coinduction:expand_coinductive_declaration(F/A, Clauses),
  715    directive_source_file(File),
  716    '$compile_aux_clauses'(Clauses, File).
  717*/
  718
  719set_meta(TGoal,is_coinductive0):- !,
  720    set_meta(TGoal,is_coinductive1),
  721    add_clauses( TGoal ,  (!, dra_call_coind0(TGoal) )),
  722    dra_asserta_new(is_coinductive0(TGoal)).
  723
  724set_meta(TGoal,is_coinductive1):- !,
  725    add_clauses( TGoal , (!, dra_call_coind1(TGoal) )),
  726    dra_asserta_new(is_coinductive1(TGoal)).
  727
  728set_meta(TGoal,is_never_tabled):- !,
  729    dra_retract_all(is_tabled(TGoal)),
  730    dra_retract_all(is_old_first(TGoal)),
  731    dra_retract_all( (TGoal :- !, dra_call_tabled(TGoal) )),
  732    (is_never_tabled(TGoal)-> true ; dra_asserta_new(is_never_tabled(TGoal))).
  733
  734set_meta(TGoal,is_tabled):-
  735    dra_retract_all(is_never_tabled(TGoal)),
  736    dra_asserta_new(is_tabled(TGoal)),
  737    add_clauses( TGoal ,  (!, dra_call_tabled(TGoal))),
  738    functor(TGoal,F,A),discontiguous(F/A).    
  739    %interp(dra_call_tabled,TGoal).
  740
  741set_meta(TGoal,is_old_first):-
  742    set_meta(TGoal,is_tabled),
  743    dra_asserta_new(is_old_first(TGoal)).
  744
  745set_meta(TGoal,Atom):- Assert=..[Atom,TGoal],
  746    dra_asserta_new(Assert).
  747
  748
  749%------------------------------------------------------------------------------
  750
  751:-ensure_loaded( library( lists ) ). % An SWI library, for reverse/2.
  752
  753%------------------------------------------------------------------------------
  754
  755%  Built-in predicates for the "dra" interpreter  %
  756
  757% If the interpreted program invokes a built-in predicate, that predicate dra_must
  758% be declared in the table "is_never_tabled/1" below.
  759% Every addition should be considered carefully: some built-ins might require
  760% special treatment by the interpreter.
  761
  762%  NOTE: findall/3 is not opaque to coinductive and tabled ancestors.
  763
  764%  NOTE: Just adding "!" won't do the trick, the main interpreter would
  765%        have to be modified substantially (but first: what are the semantics?)
  766
  767:-dynamic(is_never_tabled/1).  768:-dynamic(is_table_ok/1).  769
  770
  771%is_never_tabled( (_ -> _)           ).  % special treatment in dra_interp/4
  772%is_never_tabled( (_ -> _ ; _)       ).  % special treatment in dra_interp/4
  773%is_never_tabled( \+ ( _ )            ).  % special treatment in dra_interp/4
  774
  775is_never_tabled(Pred):-is_table_ok(Pred),!,fail.
  776is_never_tabled(Pred):-is_builtin(Pred),asserta(is_never_tabled(Pred)),!.
  777is_never_tabled(Pred):-functor(Pred,F,A),functor(TPred,F,A),asserta(is_table_ok(TPred)),!,fail.
  778
  779is_builtin(Pred) :-is_swi_builtin( Pred ).
  780is_builtin(Pred) :-functor(Pred,F,_),atom_concat('$',_,F).
  781% is_builtin(Pred) :-source_file(Pred,File),is_file_meta(File,is_never_tabled), \+ clause(is_tabled(Pred),true).
  782
  783
  784%------------------------------------------------------------------------------
  785% mk_pattern(+An atom representing the name of a predicate,
  786%             + an integer representing the arity of the predicate,
  787%             - the most general pattern that matches all invocations of the
  788%               predicate
  789%           )
  790% Given p/k, produce p( _, _, ... _ )  (of arity k)
  791
  792% :-mode mk_pattern(+,+,-).
  793
  794% mk_pattern( P, K, Pattern ) :-
  795%        length( Args, K ),                           % Args = K fresh variables
  796%        Pattern =.. [ P | Args ].
  797
  798mk_pattern( P, K, Pattern ) :-
  799        functor( Pattern, P, K ).
  800
  801
  802
  803%------------------------------------------------------------------------------
  804%% predspecs_to_patterns(+PredSpecs,-PatternsList)
  805% Given one or several predicate specifications (in the form "p/k" or
  806% "p/k, q/l, ...") check whether they are well-formed: if not, raise a fatal
  807% dra_error; otherwise return a list of the most general instances that correspond
  808% to the predicate specifications.
  809
  810:-module_transparent(predspecs_to_patterns/2).  811
  812predspecs_to_patterns( Var, _ ) :-
  813        var( Var ),
  814        !, trace, 
  815        dra_error( [ 'A variable instead of predicate specifications: \"',
  816                 Var,
  817                 '\"'
  818               ]
  819             ).
  820
  821predspecs_to_patterns( [PredSpec | PredSpecs], [ Pattern | Patterns ] ) :-
  822        !,
  823        predspec_to_pattern( PredSpec, Pattern ),
  824        predspecs_to_patterns( PredSpecs, Patterns ).
  825predspecs_to_patterns( (PredSpec , PredSpecs), [ Pattern | Patterns ] ) :-
  826        !,
  827        predspec_to_pattern( PredSpec, Pattern ),
  828        predspecs_to_patterns( PredSpecs, Patterns ).
  829
  830predspecs_to_patterns( PredSpec, [ Pattern ] ) :-
  831        predspec_to_pattern( PredSpec, Pattern ).
  832
  833
  834%------------------------------------------------------------------------------
  835% predspec_to_pattern(+PredSpec,-GeneralPaton).
  836% Given a predicate specification (in the form "p/k") check whether it is
  837% well-formed: if not, raise a fatal dra_error; otherwise return a most general
  838% instance that correspond to the predicate specification.
  839
  840predspec_to_pattern(+PredSpec,+Pattern ) :- !,predspec_to_pattern( PredSpec, Pattern ).
  841predspec_to_pattern(-PredSpec,-Pattern ) :- !,predspec_to_pattern( PredSpec, Pattern ).
  842predspec_to_pattern( M:PredSpec, M:Pattern ):- !,predspec_to_pattern( PredSpec, Pattern ).
  843predspec_to_pattern( PredSpec, Pattern ) :-Pattern \= (_/_),!,PredSpec = Pattern.
  844predspec_to_pattern( PredSpec, Pattern ) :-
  845        check_predspec( PredSpec ),
  846        PredSpec = P / K,
  847        mk_pattern( P, K, Pattern ).
  848
  849
  850%------------------------------------------------------------------------------
  851% check_predspec:
  852% Raise an dra_error if this is not a good predicate specification.
  853check_predspec( Var ) :-
  854        var( Var ),
  855        !,
  856        dra_error( [ 'A variable instead of a predicate specification: \"',
  857                 Var,
  858                 '\"'
  859               ]
  860             ).
  861
  862check_predspec( P / K ) :-
  863        atom( P ),
  864        integer( K ),
  865        K >= 0,
  866        !.
  867
  868check_predspec( PredSpec ) :-trace,
  869        dra_error( [ 'An incorrect predicate specification: \"', PredSpec, '\"' ] ).
  870
  871
  872%------------------------------------------------------------------------------
  873% The default essence_hook:
  874
  875:-dynamic essence_hook/2.  876
  877essence_hook( T, T ).    % default, may be overridden by the interpreted program
  878
  879
  880%------------------------------------------------------------------------------
  881%% are_variants(+Term,+Term )
  882%    Succeeds only if both arguments are variants of each other.
  883%    Does not instantiate any variables.
  884% NOTE:
  885%   If variant/2 turns out to be broken, replace the last call with the
  886%    following three:
  887%        \+ \+ ( T1 = T2 ),                   % quickly weed out obvious misfits
  888%        copy_term( T2, CT2 ),
  889%       \+ \+ ( (numbervars( T1, 0, N ), numbervars( CT2, 0, N ), T1 = CT2) ).
  890
  891are_variants( T1, T2 ) :-
  892        variant( T1, T2 ).
  893
  894
  895%------------------------------------------------------------------------------
  896%% write_shallow(+Output stream,+Term,+Maximum depth)
  897% Like write/2, but only to a limited print depth.
  898
  899write_shallow( OutputStream, Term, MaxDepth ) :-
  900       write_term( OutputStream, Term, [ max_depth( MaxDepth ) ] ).
  901
  902
  903%------------------------------------------------------------------------------
  904%% is_swi_builtin(?goal)
  905% Does this goal call a built-in predicate?  Or generate a built-in goal.
  906
  907is_swi_builtin( Pred ) :-
  908        ( \+ ( \+ predicate_property( Pred, built_in ))).
  909
  910
  911
  912
  913%------------------------------------------------------------------------------
  914%% dra_setval_flag(+Name,+Value)
  915% Set this counter to this value.
  916%
  917% NOTE: Since DRA uses global variables to store only integers, we use the
  918%       flag/3 facility of SWI Prolog.  For more general values we would have
  919%       to use dra_nb_setval/dra_nb_getval.  See also dra_getval_flag/2 and dra_incval_flag/1 below.
  920
  921dra_setval_flag( Name, Value ) :-flag( Name, _Old, Value ).
  922
  923
  924%------------------------------------------------------------------------------
  925%% dra_getval_flag(+Name,-Value)
  926% Get the value associated with this counter.
  927
  928dra_getval_flag( Name, Value ) :-flag( Name, Value, Value ).
  929
  930
  931%------------------------------------------------------------------------------
  932%% dra_incval_flag(+Name)
  933% Increment this counter by 1.
  934dra_incval_flag( Name ) :-flag( Name, Value, Value+1 ).
  935
  936
  937
  938
  939%==============================================================================
  940
  941
  942
  943%  The "set of coinductive hypotheses" for the "dra" interpreter.          %
  944%                                                                          %
  945%  Written by Feliks Kluzniak at UTD (March 2009)           .              %
  946%                                                                          %
  947%  Last update: 12 June 2009.                                              %
  948%                                                                          %
  949
  950% The "set of coinductive hypotheses" contains those ancestors of the current
  951% goal that invoke coinductive predicates. It is used by dra_interp/4, and factored
  952% out as an abstract data type to facilitate changing to a more efficient
  953% representation.
  954%
  955% The requirements are as follows:
  956%
  957%       (a) We must be able to check whether a coinductive goal G can be
  958%           unified with one of its ancestors.
  959%
  960%       (b) Ancestors that might be unifiable with G must be available in
  961%           reverse chronological order (i.e., the nearest ancestor first).
  962%
  963%       NOTE: Before checking for unifiability the goals must be passed
  964%             through essence_hook/2.
  965%
  966%
  967% The operations are:
  968%
  969%     empty_hypotheses(-stack of hypotheses ):
  970%         Create an empty stack for coinductive hypotheses.
  971%
  972%     push_is_coinductive(+Goal,+Stack of hypotheses ,-new stack ):
  973%         Push the coinductive goal onto the stack.
  974%
  975%     unify_with_coinductive_ancestor(+Goal,+Stack of hypotheses ):
  976%         Fail if there is no unifiable coinductive ancestor on the stack. If
  977%         there is one, succeed after performing the unification with the
  978%         most recent such ancestor.  Upon failure undo the unification and
  979%         unify with the next such ancestor, and so on (in reverse
  980%         chronological order), failing after all unifiable ancestors are
  981%         exhausted.
  982
  983
  984
  985
  986
  987%  Operations on binary trees.                                             %
  988%                                                                          %
  989%  This particular version                                                 %
  990%   written by Feliks Kluzniak at UTD (May 2009).                          %
  991%                                                                          %
  992%  Last update: 16 May 2009.                                               %
  993%                                                                          %
  994
  995%:-ensure_loaded( higher_order ).
  996
  997
  998%
  999%  The format of a node is:
 1000%       t( key, information, left subtree, right subtree )
 1001%  or
 1002%       empty.
 1003
 1004
 1005%------------------------------------------------------------------------------
 1006%% empty_otree(?OpenTree)
 1007%
 1008% Create an empty tree, or check that the provided tree is empty.
 1009
 1010empty_tree( empty ).
 1011
 1012
 1013%------------------------------------------------------------------------------
 1014%% is_in_tree(+Tree,+Key,+ComparisonLessThanPredicate,-Information)
 1015%
 1016% If the entry for this key is present in the tree, succeed and return the
 1017% associated information; if it is not, fail.
 1018% "comparison predicate" is a binary predicate that succeeds if the first
 1019% argument is smaller than the second argument.  Any predicate that implements
 1020% a total ordering will do.
 1021
 1022:-meta_predicate(is_in_tree(+,+, 2,-)). 1023is_in_tree( Node, Key, LessPred, Info ) :-
 1024        Node = t( K, I, L, R ),
 1025        (
 1026            Key = K
 1027        ->
 1028            Info = I
 1029        ;
 1030            call( LessPred,  Key, K  )
 1031        ->
 1032            is_in_tree( L, Key, LessPred, Info )
 1033        ;
 1034            is_in_tree( R, Key, LessPred, Info )
 1035        ).
 1036
 1037
 1038%------------------------------------------------------------------------------
 1039%% tree_add(+Tree,+Key,+Information,+ComparisonLTPredicate,+ModificationAddPredicate,+NewTree)
 1040%           
 1041% Make sure that the key is associated with this information in the tree.
 1042% If the entry for this key is already present, modify the existing
 1043% information.
 1044% "less predicate" is the name of a binary predicate that succeeds if the first
 1045% argument is smaller than the second argument.
 1046% "modification predicate" is a predicate of three arguments that will add
 1047% information from its second argument to its first argument, thus obtaining
 1048% the third argument.
 1049
 1050:-meta_predicate(tree_add(+,+,+, 2, 3,-)). 1051
 1052tree_add( Node, Key, Info, LessPred, ModifyPred, NewNode ) :-
 1053        (
 1054            empty_tree( Node )
 1055        ->
 1056            NewNode = t( Key, Info, L, R ),
 1057            empty_tree( L ),
 1058            empty_tree( R )
 1059        ;
 1060            Node = t( K, I, L, R ),
 1061            (
 1062                Key = K
 1063            ->
 1064                call( ModifyPred,  I, Info, NewI  ),
 1065                NewNode = t( K, NewI, L, R )
 1066            ;
 1067                call( LessPred, Key, K  )
 1068            ->
 1069                NewNode = t( Key, I, NewL, R ),
 1070                tree_add( L, Key, Info, LessPred, ModifyPred, NewL )
 1071            ;
 1072                NewNode = t( Key, I, L, NewR ),
 1073                tree_add( R, Key, Info, LessPred, ModifyPred, NewR )
 1074            )
 1075        ).
 1076
 1077%------------------------------------------------------------------------------
 1078
 1079
 1080% In this implementation the goal table is a binary tree.
 1081% Each key is a predicate specification.
 1082% The information associated with a key is a list of goals
 1083% that invoke the predicate specified by the key.
 1084
 1085
 1086%------------------------------------------------------------------------------
 1087%% empty_goal_table(?goal table)
 1088% Create an empty goal table, or check that the provided table is empty.
 1089
 1090empty_goal_table( Table ) :-
 1091        empty_tree( Table ).
 1092
 1093
 1094%------------------------------------------------------------------------------
 1095%% goal_table_member(+Goal,+Goal table)
 1096% Check whether any instantiations of the goal are in the table: if there are,
 1097% unify the goal with the first one (backtracking will unify it with each of
 1098% them in turn).
 1099%
 1100% NOTE: Using essence hook before comparison!
 1101
 1102goal_table_member( Goal, Table ) :-
 1103        functor( Goal, P, K ),
 1104        is_in_tree( Table, P / K, '@<', List ),
 1105        once( essence_hook( Goal, Essence ) ),
 1106        member_reversed( G, List ),
 1107        once( essence_hook( G, Essence ) ).
 1108
 1109
 1110%------------------------------------------------------------------------------
 1111%% is_a_variant_in_goal_table(+Goal,+Goal table)
 1112% Succeed iff a variant of this goal is present in the table.
 1113% Do not modify the goal.
 1114%
 1115% NOTE: Using essence hook before comparison!
 1116
 1117is_a_variant_in_goal_table( Goal, Table ) :-
 1118        once( essence_hook( Goal, GoalEssence ) ),
 1119        functor( Goal, P, K ),
 1120        is_in_tree( Table, P / K, '@<', List ),
 1121        member_reversed( Member, List ),
 1122        once( essence_hook( Member, MemberEssence ) ),
 1123        are_variants( MemberEssence, GoalEssence ),
 1124        !.
 1125
 1126
 1127%------------------------------------------------------------------------------
 1128%% member_reversed(?item,+ListOfItems)
 1129% Like member/2, but the order of searching/generation is reversed.
 1130
 1131member_reversed( M, [ _ | L ] ) :-
 1132        member_reversed( M, L ).
 1133member_reversed( M, [ M | _ ] ).
 1134
 1135
 1136%------------------------------------------------------------------------------
 1137%% goal_table_add(+GoalTable,+Goal,-NewGoalYable)
 1138%
 1139% Add this goal to the table.
 1140
 1141goal_table_add( Table, Goal, NewTable ) :-
 1142        functor( Goal, P, K ),
 1143        tree_add( Table, P / K, [ Goal ], '@<', add_to_list, NewTable ).
 1144
 1145%
 1146add_to_list( List, [ Item ], [ Item | List ] ).
 1147
 1148%------------------------------------------------------------------------------
 1149
 1150
 1151
 1152% :-mode empty_hypotheses(-).
 1153
 1154empty_hypotheses( Hyp ) :-
 1155        empty_goal_table( Hyp ).
 1156
 1157
 1158% :-mode push_is_coinductive(+,+,-).
 1159
 1160push_is_coinductive( Goal, Hyp, NewHyp ) :-
 1161        goal_table_add( Hyp, Goal, NewHyp ).
 1162
 1163
 1164
 1165% %--------------  The minimal implementation:  --------------%
 1166% %
 1167% % The set of coinductive hypotheses is just a list.
 1168%
 1169% :-mode empty_hypotheses(-).
 1170%
 1171% empty_hypotheses( [] ).
 1172%
 1173%
 1174% :-mode push_is_coinductive(+,+,-).
 1175%
 1176% push_is_coinductive( Goal, Hyp, [ Goal | Hyp ] ).
 1177%
 1178%
 1179% :-mode unify_with_coinductive_ancestor(+,+).
 1180%
 1181% unify_with_coinductive_ancestor( Goal, Hyp ) :-
 1182%         once( essence_hook( Goal, Essence ) ),
 1183%         member( G, Hyp ),
 1184%         once( essence_hook( G, Essence ) ).
 1185
 1186% :-mode unify_with_coinductive_ancestor(+,+).
 1187
 1188unify_with_coinductive_ancestor( Goal, Hyp ) :-
 1189        goal_table_member( Goal, Hyp ).
 1190
 1191%------------------------------------------------------------------------------
 1192
 1193
 1194%
 1195
 1196%  The "stack" data type for the "dra" interpreter.                        %
 1197%                                                                          %
 1198%  Written by Feliks Kluzniak at UTD (March 2009)           .              %
 1199%                                                                          %
 1200%  Last update: 12 June 2009.                                              %
 1201%                                                                          %
 1202
 1203% The "stack" is the chain of tabled ancestors used by dra_interp/4.  It is
 1204% factored out as an abstract data type to facilitate changing to a more
 1205% efficient representation.
 1206%
 1207% The requirements are as follows:
 1208%
 1209%       (a) It must be possible to check whether a tabled goal G and one of
 1210%           its ancestors are variants. There can be at most one such
 1211%           ancestor, call it A.
 1212%
 1213%       (b) We must be able to identify the "current clause" that was used by
 1214%           A and that led to the creation of G.
 1215%
 1216%       (c) We must be able to identify all the tabled goals that are
 1217%           descendants of A and ancestors of G (i.e., all tabled goals
 1218%           "between" G and A).
 1219%
 1220%       NOTE: Before checking for variance the goals must be passed
 1221%             through essence_hook/2.
 1222%
 1223%
 1224% Information about an ancestor goal is kept in the form of a triple:
 1225%    triple( goal, index, clause )
 1226% where
 1227%    goal    is the (current instantiation of the) goal;
 1228%    index   is the unique index of the goal;
 1229%    clause  is the clause that is currently used by the goal (it has been
 1230%               instantiated by matching with the goal in its original form,
 1231%               but does not share variables with the goal).
 1232%
 1233%
 1234% The operations are:
 1235%
 1236%     empty_stack(-stack )
 1237%            Create an empty stack.
 1238%
 1239%     push_is_tabled(+Goal,+Index,+Clause,+Stack,-new stack )
 1240%            where the first three arguments are the constitutive elements of
 1241%            a triple.
 1242%            Push the triple goal onto the stack.
 1243%
 1244%    is_variant_of_ancestor(+Goal,
 1245%                            +Stack,
 1246%                            - the triple with the variant ancestor,
 1247%                            - goals between goal and the variant ancestor
 1248%                          )
 1249%         Succeed if the tabled goal is a variant of some goal in the stack.
 1250%         If successful, return the first such member and the list of
 1251%         intervening triples.
 1252
 1253
 1254% %--------------  The minimal implementation:  --------------%
 1255% %
 1256% % The stack is just a list of triples.
 1257%
 1258% :-mode empty_stack(-).
 1259%
 1260% empty_stack( [] ).
 1261%
 1262%
 1263% :-mode push_is_tabled(+,+,+,+,-).
 1264%
 1265% push_is_tabled( Goal, PGIndex, Clause, Stack,
 1266%              [ triple( Goal, PGIndex, Clause ) | Stack ]
 1267%            ).
 1268%
 1269%
 1270% :-mode is_variant_of_ancestor(+,+,-,-).
 1271%
 1272% is_variant_of_ancestor( Goal, Stack, AncestorTriple, Prefix ) :-
 1273%         append( Prefix, [ AncestorTriple | _ ], Stack ),      % split the list
 1274%         AncestorTriple = triple( G, _, _ ),
 1275%         are_essences_variants( Goal, G ),
 1276%         !.
 1277
 1278
 1279%--------------  An implementation that uses goal_table:  --------------%
 1280%
 1281% The goal table is used to speed up the check whether there is a variant
 1282% ancestor.  We still need a standard stack for getting the intermediate tabled
 1283% goals.  So the "stack" is represented by
 1284%    tstack( stack, goal table )
 1285
 1286
 1287%:-ensure_loaded( 'goal_table_in_tree' ).
 1288
 1289
 1290% :-mode empty_stack(-).
 1291
 1292empty_stack( tstack( [], Table ) ) :-
 1293        empty_goal_table( Table ).
 1294
 1295
 1296% :-mode push_is_tabled(+,+,+,+,-).
 1297
 1298push_is_tabled( Goal, PGIndex, Clause, tstack( Stack, Table ),
 1299             tstack( [ triple( Goal, PGIndex, Clause ) | Stack ], NewTable )
 1300           ) :-
 1301        goal_table_add( Table, Goal, NewTable ).
 1302
 1303
 1304% :-mode is_variant_of_ancestor(+,+,-,-).
 1305
 1306is_variant_of_ancestor( Goal,
 1307                        tstack( Stack, Table ),
 1308                        AncestorTriple,
 1309                        Prefix
 1310                      ) :-
 1311        is_a_variant_in_goal_table( Goal, Table ),           % preliminary check
 1312        append( Prefix, [ AncestorTriple | _ ], Stack ),     % split the list
 1313        AncestorTriple = triple( G, _, _ ),
 1314        are_essences_variants( Goal, G ),
 1315        !.
 1316
 1317%------------------------------------------------------------------------------
 1318
 1319
 1320% Initialization of tables:
 1321
 1322:-dynamic (is_coinductive0)/1 . 1323:-dynamic (is_coinductive1)/1 . 1324:-dynamic (is_tabled)/1 . 1325:-dynamic (is_old_first)/1 . 1326:-dynamic (is_traced)/1. 1327
 1328:-dra_setval_flag( number_of_answers, 0 ). 1329:-dra_setval_flag( unique_index,      0 ). 1330
 1331dra_version('DRA ((c) UTD 2009) version 0.97 (beta), June 2011 - LOGICMOO').
 1332
 1333initialize_table:- abolish_tables,
 1334      retractall( is_coinductive0( _ )  ),
 1335      retractall( is_coinductive1( _ ) ),
 1336      retractall( is_tabled( _ )       ),
 1337      retractall( is_old_first( _ )    ),
 1338      dra_must((dra_version( Version ),
 1339      dra_w( Version ))).
 1340
 1341abolish_tables :-                                        % invoked by top_level
 1342   dra_must((
 1343        reinitialise_answer,
 1344        reinitialise_result,
 1345        reinitialise_pioneer,
 1346        reinitialise_loop,
 1347        reinitialise_looping_alternative,
 1348        reinitialise_completed,
 1349        retractall( is_traced( _ )      ),
 1350        dra_setval_flag( number_of_answers, 0 ),
 1351        dra_setval_flag( unique_index,      0 ),
 1352        dra_setval_flag( step_counter,      0 ),
 1353        dra_setval_flag( old_table_size,    0 ))),!.
 1354
 1355
 1356%  Administration  %
 1357:-op( 1010, fy, table       ).    % allow  ":-table p/k ."
 1358:-op( 1010, fy, old_first    ).    % allow  ":-old_first p/k ."
 1359:-op( 1010, fy, never_table        ).    % allow  ":-traces  p/k ."
 1360:-op( 1010, fy, coinductive0  ).    % allow  ":-coinductive0 p/k ."
 1361:-op( 1010, fy, coinductive1 ).    % allow  ":-coinductive1 p/k ."
 1362:-op( 1010, fy, hilog    ).    % allow  ":-hilog  p/k ."
 1363:-op( 910,  fy, tnot    ).    % allow  "?- tnot  p(_) ."
 1364
 1365
 1366
 1367% The legal directives (check external form only).  (Used by the top level.)
 1368
 1369
 1370%legal_directive(M:P):-atom(M),M:legal_directive(P).
 1371%legal_directive(P):-compound(P),functor(P,F,1),property_pred(F).
 1372legal_directive((coinductive( _))  ).
 1373% legal_directive( (coinductive0 _)  ).
 1374legal_directive( (coinductive1 _) ).
 1375legal_directive( (table _)       ).
 1376legal_directive( (dynamic _)      ).
 1377legal_directive( (old_first _)    ).
 1378legal_directive( (multifile _)    ).
 1379legal_directive( answers( _, _ )  ).
 1380legal_directive( answers          ).
 1381legal_directive((call( _))  ).
 1382legal_directive((hilog( _))  ).
 1383
 1384% SWI=Prolog
 1385legal_directive( trace ).
 1386legal_directive( notrace ).
 1387
 1388legal_directive(M:P):-atom(M),M:legal_directive(P).
 1389legal_directive(P):-compound(P),functor(P,F,1),property_pred(F,_).
 1390
 1391% Check and process the legal directives (invoked by top_level)
 process_dra_ective(+Directive)
Process a directive.
 1396:-module_transparent(process_dra_ective/1). 1397
 1398process_dra_ective( Directive ) :-           % unsupported directive
 1399       \+ legal_directive( Directive ),
 1400        !,
 1401        dra_error( lines( [ 'Unknown directive:', [ (:-Directive), '.' ] ] ) ).
 1402
 1403process_dra_ective( answers( Goal, Pattern ) ) :-
 1404        dra_w(print_required_answers( Goal, Pattern )).
 1405
 1406%process_dra_ective( Dir ) :-property_pred(F,DBF), Dir=..[F,all],DB=..[DBF,_], !, once((source_context(F),add_file_meta(F,DBF));dra_asserta_new( DB:- ! )).
 1407%process_dra_ective( Dir ) :-property_pred(F,DBF), (Dir=..[F,none];Dir=..[F,-all]),DB=..[DBF,_], !, once((source_context(F),dra_retract_all(is_file_meta(F,DBF)));(dra_retract_all( DB ),dra_retract_all( DB :- ! ))).
 1408process_dra_ective( Dir ) :-
 1409        property_pred(F,DBF), 
 1410        Dir=..[F,PredSpecs],
 1411        predspecs_to_patterns( PredSpecs, Patterns ),!,
 1412        add_patterns(Patterns,DBF).
 1413
 1414:- meta_predicate add_pattern(+,+). 1415
 1416add_patterns([],_):- !.
 1417add_patterns([P|Patterns],DBF):-add_pattern(P,DBF),!,add_patterns(Patterns,DBF).
 1418
 1419add_pattern(Pattern,-DBF):- !, DB=..[DBF,Pattern], dra_retract_all( DB ).
 1420add_pattern(Pattern,+ DBF):- !, add_pattern(Pattern, DBF).
 1421add_pattern(Pattern,DBF):-DB=..[DBF,Pattern],
 1422        set_meta(Pattern,DBF),
 1423        dra_assertz_new( DB ),!.
 1424
 1425
 1426
 1427%
 1428%  The interpreter  %
 1429
 1430% tnot/1 must be ran in meta-interp
 1431'tnot'(G):-dra_call_interp('tnot'(G)).
 1432% invoked by VMI/WAM to Execute a query.
 1433:-module_transparent(dra_call_tabled/1). 1434dra_call_tabled(G) :- dra_use_interp(dra_call_tabled,G) .
 1435:-module_transparent(dra_call_coind0/1). 1436dra_call_coind0(G):-dra_use_interp(dra_interp,G).
 1437:-module_transparent(dra_call_coind1/1). 1438dra_call_coind1(G):-dra_use_interp(dra_interp,G).
 1439:-module_transparent(dra_call_interp/1). 1440dra_call_interp(G):-dra_use_interp(dra_interp,G).
 1441
 1442
 1443
 1444:- meta_predicate dra_use_interp(5,?). 1445dra_use_interp(Type,Goals ) :-
 1446      '$dra':dra_must(b_getval('$tabling_exec',dra_state(Stack, Hyp, ValOld, CuttedOut))),
 1447      setup_call_cleanup(
 1448        ((ValOld < 0) -> (( '$dra':init_dra_call,EXIT = '$dra':exit_dra_call )); (EXIT = '$dra':cont_dra_call)),
 1449        (( Level is ValOld +1,
 1450            call(Type,Cutted, Goals, Stack, Hyp, Level ),
 1451            ((var(Cutted);((trace),'$dra':non_cutted(Goals,Cutted,(CuttedOut))))->true;(!,fail)),
 1452             EXIT)),
 1453       ((EXIT))).
 1454
 1455
 1456init_dra_call:-
 1457        reinitialise_pioneer,
 1458        reinitialise_result,
 1459        reinitialise_loop,
 1460        reinitialise_looping_alternative,
 1461        dra_setval_flag( unique_index,      0    ),
 1462        dra_getval_flag( number_of_answers, NAns ),
 1463        dra_setval_flag( old_table_size,    NAns ),
 1464        dra_setval_flag( step_counter,      0    ).
 1465
 1466cont_dra_call :-
 1467				print_statistics,
 1468				system:'$exit_dra'.
 1469
 1470exit_dra_call:-
 1471				print_statistics,
 1472				dra_setval_flag( step_counter, 0 ),
 1473				dra_getval_flag( number_of_answers, NAns2 ),
 1474				dra_setval_flag( old_table_size, NAns2 ),
 1475				system:'$exit_dra'.
 1476
 1477
 1478% Print information about the number of steps and the answer table.
 1479print_statistics :-  notrace((      
 1480        dra_getval_flag( step_counter, NSteps ),
 1481        dra_getval_flag( number_of_answers, NAns ),
 1482        dra_getval_flag( old_table_size, OldNAns ),
 1483        TableGrowth is NAns - OldNAns,
 1484        ( TableGrowth>0
 1485				   ->dra_wln([step=NSteps,growth=TableGrowth,tabled=NAns]);true))).
 dra_interp(?Cutted, +Goal, +Stack, +CoinductiveHypotheses, +Level)
Solve the sequence of goals, maintaining information about the current chain of tabled ancestors(stack) and the chain of coinductive0 ancestors (coinductive hypotheses). The level is the level of recursion, and is used only for tracing.
Each link in the chain of tabled ancestors is of the form triple( goal, index, clause ) where goal is the (current instantiation of the) goal; index is the unique index of the goal (every goal that is stacked starts out as a pioneer!) clause is the clause that is currently used by the goal (it has been instantiated by matching with the goal in its original form, but does not share variables with the goal).
NOTE: The set of coinductive hypotheses and the stack of tabled ancestors have been factored out (see files "dra_coinductive_hypotheses.pl" and "dra_stack.pl" ) The representations may have changed (to enable faster access, so the comments in this file ("chain of ancestors" etc.) might no longer be quite accurate. )
 1515:-
 1516  empty_hypotheses( Hyp ),
 1517  empty_stack( Stack ),
 1518  nb_setval('$tabling_exec',dra_state(Stack, Hyp,-1, _CuttedOut)). 1519
 1520
 1521% this next meta_predicate decl causes an infinate loop
 1522:- meta_predicate dra_interp(*,0,*,*,*). 1523% so we use the next line insteal to repress 
 1524%  Found new meta-predicates in iteration 1 (0.072 sec)
 1525:- meta_predicate dra_interp(-,+,+,+,+). 1526:- module_transparent(dra_interp/5). 1527
 1528
 1529
 1530dra_interp(CuttedOut, Goal, Stack, Hyp,  Level ):- assertion(nonvar(Goal)),
 1531   is_tabled(Goal),!,
 1532   dra_call_tabled(Cutted, Goal, Stack, Hyp, Level ),
 1533  ((var(Cutted);non_cutted(Goal,Cutted, CuttedOut))->true;(!,fail)).
 1534
 1535% simply true.
 1536dra_interp(_ ,     true, _, _, _ ) :- !.
 1537
 1538% A negation.
 1539dra_interp(Cutted, ((\+ Goal)), Stack, Hyp, Level ) :- 
 1540        !,
 1541        NLevel is Level +1,
 1542        trace_entry( normal, \+ Goal, '?', Level ),
 1543        (
 1544            \+ dra_interp(Cutted, Goal, Stack, Hyp, NLevel ),
 1545            trace_success( normal, \+ Goal, '?', Level )
 1546        ;
 1547            trace_failure( normal, \+ Goal, '?', Level ),
 1548            fail
 1549        ).
 1550
 1551
 1552% special tnot/1
 1553dra_interp(Cutted, ( (tnot Goal)) , Stack, Hyp, Level ) :- !, findall(Cutted-Goal,dra_interp(Cutted, Goal , Stack, Hyp, Level ),L),L=[].
 1554
 1555% One solution.
 1556dra_interp(Cutted, once( Goal ), Stack, Hyp, Level ) :-
 1557        !,
 1558        NLevel is Level +1,
 1559        trace_entry( normal, once( Goal ), '?', Level ),
 1560        (
 1561            once( dra_interp(Cutted, Goal, Stack, Hyp, NLevel ) ),
 1562            trace_success( normal, once( Goal ), '?', Level )
 1563        ;
 1564            trace_failure( normal, once( Goal ), '?', Level ),
 1565            fail
 1566        ).
 1567
 1568
 1569% A conditional with an else.
 1570dra_interp(Cutted, (Cond -> Then ; Else), Stack, Hyp, Level ) :- !,
 1571      (  dra_interp(Cutted, Cond, Stack, Hyp, Level ) ->        
 1572        dra_interp(Cutted, Then, Stack, Hyp, Level ) ;
 1573        dra_interp(Cutted, Else, Stack, Hyp, Level )).
 1574
 1575
 1576% A conditional without an else.
 1577dra_interp(Cutted, (Cond -> Then), Stack, Hyp, Level ) :- !,
 1578        (dra_interp(Cutted, Cond, Stack, Hyp, Level ) -> dra_interp(Cutted, Then, Stack, Hyp, Level )).
 1579
 1580% or
 1581dra_interp(Cutted, (GoalsL ; GoalsR), Stack, Hyp, Level ) :- !,
 1582        (dra_interp(Cutted, GoalsL, Stack, Hyp, Level ) ;
 1583         dra_interp(Cutted, GoalsR, Stack, Hyp, Level )).
 1584
 1585
 1586% A conjunction.
 1587dra_interp(Cutted, (Goals1 , Goals2), Stack, Hyp, Level ) :- !,
 1588        dra_interp(Cutted, Goals1, Stack, Hyp, Level ),
 1589        dra_interp(Cutted, Goals2, Stack, Hyp, Level ).
 1590
 1591
 1592% call/1
 1593dra_interp(Cutted, call( Goal ), Stack, Hyp, Level ) :- !,dra_interp(Cutted, Goal, Stack, Hyp, Level ) .
 1594
 1595
 1596% findall/3: note that this is not opaque to coinductive and tabled ancestors!
 1597dra_interp(Cutted, findall( Template, Goal, Bag ), Stack, Hyp, Level ) :- !,
 1598        NLevel is Level +1,
 1599        findall( Template, dra_interp(Cutted, Goal, Stack, Hyp, NLevel ), Bag ).
 1600
 1601% cut
 1602dra_interp(Cutted, !, _, _, _ ) :- !, (var(Cutted);Cutted=cut).
 1603% cut to Label
 1604dra_interp(Cutted, !(Where), _, _, _ ) :- !, (var(Cutted);Cutted=cut_to(Where)).
 1605
 1606
 1607% A goal that is coinductive, but not tabled.
 1608% Apply the coinductive hypotheses first, then the clauses.
 1609%
 1610% NOTE: Now that we have both "coinductive0" and "coinductive1" the logic gets a
 1611%       little tricky.  If a goal is not "coinductive2", then it should activate
 1612%       its clauses only if there are no unifiable ancestors (hypotheses). What
 1613%       follows is an attempt to avoid too much duplication of code and
 1614%       redundant invocations of the costly check for unifiable ancestors.
 1615
 1616dra_interp(Cutted, Goal, Stack, Hyp, Level ) :-fail,
 1617        is_coinductive1( Goal ),
 1618        !,
 1619        dra_incval_flag( step_counter ),
 1620        trace_entry( coinductive0, Goal, '?', Level ),
 1621        (
 1622            \+ is_coinductive0( Goal ),
 1623            unify_with_coinductive_ancestor( Goal, Hyp )
 1624        ->
 1625            (
 1626                trace_success( 'coinductive (hypothesis)', Goal, '?', Level )
 1627            ;
 1628                trace_failure( coinductive, Goal, '?', Level ),
 1629                fail
 1630            )
 1631        ;
 1632            % coinductive0, or no unifiable ancestors
 1633            (
 1634                is_coinductive0( Goal ),
 1635                unify_with_coinductive_ancestor( Goal, Hyp ),
 1636                trace_success( 'coinductive0(hypothesis)', Goal, '?', Level )
 1637            ;
 1638                NLevel is Level +1,
 1639                use_clause(Goal, Body ),
 1640                push_is_coinductive( Goal, Hyp, NHyp ),
 1641                dra_interp(Cutted, Body, Stack, NHyp, NLevel ),
 1642                trace_success( 'coinductive (clause)', Goal, '?', Level )
 1643            ;
 1644                trace_failure( coinductive, Goal, '?', Level ),
 1645                fail
 1646            )
 1647        ).
 1648
 1649
 1650% Some other supported built-in.
 1651dra_interp(CuttedOut, NeverTable, Stack, Hyp,  Level ):- % is_never_tabled(NeverTable),
 1652     !,
 1653     b_setval('$tabling_exec',dra_state(Stack, Hyp, Level, Cutted)),
 1654     call(NeverTable ),        
 1655    ((var(Cutted);(trace,non_cutted(NeverTable,Cutted, CuttedOut)))->true;(!,fail)). 
 1656
 1657
 1658dra_interp(CuttedOut, Goal, Stack, Hyp,  Level ):- fail, is_cut_ok(Goal),
 1659  % Should read the new default
 1660  set_meta(Goal,is_tabled),!,
 1661  dra_call_tabled(Cutted, Goal, Stack, Hyp,  Level ),
 1662  ((var(Cutted);non_cutted(Goal,Cutted, CuttedOut))->true;(!,fail)). 
 1663
 1664% A "normal" goal (i.e., not tabled, not coinductive).
 1665dra_interp(Cutted, Goal, Stack, Hyp, Level ):-
 1666       trace_entry( normal, Goal, '?', Level ),
 1667        (
 1668            NLevel is Level +1,
 1669            use_clause( Goal, Body ),
 1670            dra_interp(Cutted, Body, Stack, Hyp, NLevel ),
 1671            trace_success( normal, Goal, '?', Level )
 1672        ;
 1673            trace_failure( normal, Goal, '?', Level ),
 1674            fail
 1675        ).
 1676
 1677
 1678non_cutted(_,cut,_):- !,fail.
 1679non_cutted(Goal,cut_to(ToGoal),_):-dra_must(nonvar(ToGoal)), Goal=ToGoal, !,fail.
 1680non_cutted(_,Cutted,Cutted).
 1681
 1682% A tabled goal that has been completed: all the results are in "answer".
 1683:-module_transparent(dra_call_tabled/5). 1684
 1685dra_call_tabled(_Cutted, Goal, _, _, Level ) :-
 1686        is_completed( Goal ),
 1687        !,
 1688        dra_incval_flag( step_counter ),
 1689        trace_entry( completed, Goal, '?', Level ),
 1690        (
 1691            get_all_tabled_answers( Goal, '?', completed, Level )
 1692        ;
 1693            trace_failure( completed, Goal, '?', Level ),
 1694            fail
 1695        ).
 1696
 1697
 1698% A tabled goal that has a variant among its ancestors (and has not been
 1699% completed).
 1700% If the goal is not coinductive, only the existing (most likely incomplete)
 1701% results from "answer" are  returned before failure.
 1702% If the goal is also coinductive, return the results that arise from
 1703% coinductive hypotheses, then the remaining results from "answer".
 1704%
 1705% NOTE: 1. There can be only one variant ancestor, so the question of which one
 1706%          to use does not arise.
 1707%
 1708%       2. Ancestor pioneer goals between this goal and its variant ancestor
 1709%          will lose their status as pioneers (and the associated entries in
 1710%          "loop" and "looping_alternative" will be removed).
 1711%
 1712%       3. If the variant ancestor is a pioneer, then:
 1713%             - the entire prefix of the list of goals upto (but not including)
 1714%               the variant ancestor will be added to the cluster of that
 1715%               ancestor (by storing it in "loop");
 1716%             - a copy of the current clause invoked by the ancestor (which can
 1717%               be found together with the ancestor on the stack) is added to
 1718%               "looping_alternative" entries for that ancestor.
 1719%
 1720%       4. If this goal is coinductive, then we use "result" to avoid
 1721%          duplicating results.
 1722
 1723dra_call_tabled(_Cutted, Goal, Stack, Hyp, Level ) :-
 1724        is_variant_of_ancestor( Goal, Stack,
 1725                                triple( G, I, C ), InterveningTriples
 1726                              ),
 1727        !,
 1728        dra_incval_flag( step_counter ),
 1729        get_unique_index( PGIndex ),
 1730        trace_entry( variant, Goal, PGIndex, Level ),
 1731        % Rescind the status of intervening pioneers:
 1732        suppress_pioneers_on_list( InterveningTriples, Level ),
 1733
 1734        % Create a looping alternative if the variant ancestor is a pioneer:
 1735        (
 1736            is_a_variant_of_a_pioneer( G, I )
 1737        ->
 1738            extract_goals( InterveningTriples, InterveningGoals ),
 1739            add_loop( I, InterveningGoals ),
 1740            add_looping_alternative( I, C )
 1741        ;
 1742            true
 1743        ),
 1744
 1745        % The main action:
 1746        (
 1747            is_coinductive1( Goal )
 1748        ->
 1749            copy_term( Goal, OriginalGoal ),
 1750            (
 1751                get_tabled_if_old_first( Goal, PGIndex,
 1752                                         'variant (coinductive0)', Level
 1753                                       )
 1754            ;
 1755                % results from coinductive hypotheses:
 1756                unify_with_coinductive_ancestor( Goal, Hyp ),
 1757                \+ is_answer_known( OriginalGoal, Goal ),    % postpone "old"
 1758                memo( OriginalGoal, Goal, Level ),
 1759                new_result_or_fail( PGIndex, Goal ),           % i.e., note answer
 1760                trace_success( 'variant (coinductive0)', Goal, PGIndex, Level )
 1761            ;
 1762                % other tabled results
 1763                get_remaining_tabled_answers( Goal, PGIndex, variant, Level )
 1764            ;
 1765                % wrap it up
 1766                trace_failure( 'variant (coinductive0)', Goal, PGIndex, Level ),
 1767                retractall( result( PGIndex, _ ) ),
 1768                fail
 1769            )
 1770        ;
 1771
 1772            % Not coinductive, just sequence through tabled answers:
 1773            (
 1774                get_all_tabled_answers( Goal, PGIndex, variant, Level )
 1775            ;
 1776                trace_failure( variant, Goal, PGIndex, Level ),
 1777                retractall( result( PGIndex, _ ) ),
 1778                fail
 1779            )
 1780        ).
 1781
 1782
 1783% A pioneer goal is called by program clauses, producing results that are stored
 1784% in "answer".
 1785% The goal succeeds as each new answer (i.e., an answer heretofore unknown for
 1786% this goal) is produced, and tries to come up with more after backtracking.
 1787% When the usual clauses are exhausted, clauses stored in the associated entries
 1788% of "looping_alternative" will be used to produce more answers (but only those
 1789% that have not yet been produced by the goal), until a fixed point is reached.
 1790% The pioneer (and all the goals in its cluster) will then be marked as
 1791% complete, and will cease to be a pioneer.
 1792%
 1793% Note that a pioneer may also lose its status when some descendant goal finds
 1794% a variant ancestor that is also an ancestor of the pioneer.  See the case
 1795% of "variant of ancestor" above.
 1796%
 1797% Note also that a goal might become completed after it succeeded (because
 1798% another variant goal "on the right" has completed), so after backtracking it
 1799% might not be necessary to continue the computation with the remaining clauses:
 1800% the rest of the results should be picked up from the table, instead.
 1801
 1802dra_call_tabled(Cutted, Goal, Stack, Hyp, Level ) :-
 1803        (
 1804            is_coinductive1( Goal )
 1805        ->
 1806            push_is_coinductive( Goal, Hyp, NHyp )
 1807        ;
 1808            NHyp = Hyp
 1809        ),
 1810        dra_incval_flag( step_counter ),
 1811        copy_term( Goal, OriginalGoal ),
 1812        add_pioneer( Goal, PGIndex ),
 1813        trace_entry( pioneer, Goal, PGIndex, Level ),
 1814
 1815        (
 1816            get_tabled_if_old_first( Goal, PGIndex, pioneer, Level )
 1817        ;
 1818
 1819            NLevel is Level +1,
 1820            use_clause(Goal, Body ),
 1821            \+ is_completed( OriginalGoal ), % might well be, after backtracking
 1822            copy_term( (Goal :-Body), ClauseCopy ),
 1823            push_is_tabled( OriginalGoal, PGIndex, ClauseCopy, Stack, NStack ),
 1824            dra_interp(Cutted, Body, NStack, NHyp, NLevel ),
 1825            \+ is_answer_known( OriginalGoal, Goal ),   % postpone "old" answers
 1826            memo( OriginalGoal, Goal, Level ),
 1827            new_result_or_fail( PGIndex, Goal ),          % i.e., note the answer
 1828            trace_success( pioneer, Goal, PGIndex, Level )
 1829        ;
 1830
 1831            % All the clauses have been exhausted, except for looping
 1832            % alternatives (if any).  However, the goal may have become
 1833            % completed (by a later variant), or it might have lost its pioneer
 1834            % status (because it belongs to a larger loop).
 1835
 1836            is_completed( Goal )                      % a variant has completed?
 1837        ->
 1838            trace_other( 'Removing completed pioneer', Goal, PGIndex, Level ),
 1839            rescind_pioneer_status( PGIndex ),
 1840            get_remaining_tabled_answers( Goal, PGIndex, 'completed now', Level )
 1841        ;
 1842
 1843            is_a_variant_of_a_pioneer( Goal, PGIndex )  % not lost pioneer status?
 1844        ->
 1845            (
 1846                trace_other( 'Computing fixed point for', Goal, PGIndex, Level ),
 1847                compute_fixed_point( Goal, PGIndex, Stack, Hyp, Level ),
 1848                \+ new_result_or_fail( PGIndex, Goal ),
 1849                trace_success( pioneer, Goal, PGIndex, Level )
 1850            ;
 1851                trace_other( 'Fixed point computed', Goal, PGIndex, Level ),
 1852                complete_goal( Goal, Level ),
 1853                complete_cluster( PGIndex, Level ),
 1854                trace_other( 'Removing pioneer', Goal, PGIndex, Level ),
 1855                rescind_pioneer_status( PGIndex ),
 1856                get_remaining_tabled_answers( Goal, PGIndex,
 1857                                              'completed now', Level
 1858                                            )
 1859            ;
 1860                retractall( result( PGIndex, _ ) ),
 1861                fail
 1862            )
 1863        ;
 1864
 1865            (
 1866                % No longer a pioneer and not completed, so just sequence
 1867                % through the remaining available tabled answers.
 1868                get_remaining_tabled_answers( Goal, PGIndex,
 1869                                              '(no longer a pioneer)', Level
 1870                                            )
 1871            ;
 1872                trace_failure( '(no longer a pioneer)', Goal, PGIndex, Level ),
 1873                retractall( result( PGIndex, _ ) ),
 1874                fail
 1875            )
 1876        ).
 get_tabled_if_old_first(+Goal, +PGIndex, +TraceLabel, +Level)
If the goal has been declared as "old_first", produce all the tabled answers, remembering them in "result", then succeed; otherwise just fail.
 1885% :-mode get_tabled_if_old_first(+,+,+,+).
 1886
 1887get_tabled_if_old_first( Goal, PGIndex, Label, Level ) :-
 1888        is_old_first( Goal ),
 1889        get_all_tabled_answers( Goal, PGIndex, Label, Level ),
 1890        new_result_or_fail( PGIndex, Goal ).     % i.e., make a note of the answer
 get_all_tabled_answers(+Goal, +PGIndex, +TraceLabel, +Level)
Return (one by one) all the answers that are currently tabled for this goal. (Each answer is returned by appropriately instantiating the goal.)
 1897% :-mode get_all_tabled_answers(+,+,+,+).
 1898
 1899get_all_tabled_answers( Goal, PGIndex, Label, Level ) :-
 1900        get_answer( Goal ),
 1901        trace_success( Label, Goal, PGIndex, Level ).
 get_remaining_tabled_answers(+Goal, +PGIndex, +TraceLabel, +Level)
Return (one by one) all the answers that are currently tabled for this goal but are not present in its "result" entries. (Each answer is returned by appropriately instantiating the goal.)
 1910% :-mode get_remaining_tabled_answers(+,+,+,+).
 1911
 1912get_remaining_tabled_answers( Goal, PGIndex, Label, Level ) :-
 1913        get_answer( Goal ),
 1914        \+ is_result_known( PGIndex, Goal ),
 1915        trace_success( Label, Goal, PGIndex, Level ).
 1916
 1917
 1918
 1919% use_clause(+Module,+Goal,+Body).
 1920% Warn and fail if the goal invokes a non-existing predicate.  Otherwise
 1921% nondeterministically return the appropriately instantiated body of each
 1922% clause whose head matches the goal.
 1923
 1924% :-meta_predicate(use_clause(:,-)).
 1925:- module_transparent(use_clause/2). 1926use_clause(Goal, Body ) :-
 1927   predicate_property(Goal,number_of_clauses(_)),!, clause(Goal, Body ),Body \= (!,_).
 1928
 1929use_clause(Goal, Body ) :-set_meta(Goal, is_never_tabled),Body = call(Goal).
Solve the goal by associated rules from "looping_alternative", succeeding with each new answer (and tabling it). Fail when all the possible results are exhausted.
 1940% :-mode(compute_fixed_point( 0,+,+,+,+)).
 1941
 1942compute_fixed_point( Goal, PGIndex, Stack, Hyp, Level ) :-
 1943        NLevel is Level +1,
 1944        (
 1945            is_coinductive1( Goal )
 1946        ->
 1947            push_is_coinductive( Goal, Hyp, NHyp )
 1948        ;
 1949            NHyp = Hyp
 1950        ),
 1951        dra_getval_flag( number_of_answers, NAns ),
 1952        compute_fixed_point_( Goal, PGIndex, Stack, NHyp, NLevel, NAns ).
 1953
 1954%
 1955% :-mode compute_fixed_point_(0,+,+,+,+,+).
 1956
 1957compute_fixed_point_( Goal, PGIndex, Stack, Hyp, Level, _ ) :-
 1958        copy_term( Goal, OriginalGoal ),
 1959        get_looping_alternative( PGIndex, (G :-Body) ),        % i.e., iterate
 1960        \+ \+ G = Goal,
 1961        copy_term( (G :-Body), ClauseCopy ),
 1962        G = Goal,
 1963        push_is_tabled( OriginalGoal, PGIndex, ClauseCopy, Stack, NStack ),
 1964        dra_interp(Cutted, Body, NStack, Hyp, Level ),
 1965        (nonvar(Cutted)-> print_message(warning,[warning,'cutted at ',Cutted]); true),
 1966        new_result_or_fail( PGIndex, Goal ),
 1967        memo( OriginalGoal, Goal, Level ).
 1968
 1969compute_fixed_point_( Goal, PGIndex, Stack, Hyp, Level, NAns ) :-
 1970        dra_getval_flag( number_of_answers, NAnsNow ),
 1971        NAnsNow \= NAns,                % i.e., fail if there are no new answers
 1972        compute_fixed_point_( Goal, PGIndex, Stack, Hyp, Level, NAnsNow ).
 suppress_pioneers_on_list(+ListOfTriples, +Level)
If any of the triples describe goals that are pioneers, make sure those goals cease to be pioneers.
 1980suppress_pioneers_on_list( Triples, Level ) :-
 1981        member( triple( M, MI, _ ), Triples ),
 1982        is_a_variant_of_a_pioneer( M, MI ),
 1983        trace_other( 'Removing pioneer', M, MI, Level ),
 1984        rescind_pioneer_status( MI ),
 1985        fail.
 1986
 1987suppress_pioneers_on_list( _, _ ).
 rescind_pioneer_status(+Index)
Remove auxiliary table entries for the pioneer with this index. Specifically, clean up "pioneer", "loop" and "looping_alternative".
 1995% :-mode rescind_pioneer_status(+).
 1996
 1997rescind_pioneer_status( PGIndex ) :-
 1998        delete_pioneer( PGIndex ),
 1999        delete_loops( PGIndex ),
 2000        delete_looping_alternatives( PGIndex ).
 complete_cluster(+PioneerIndexOfGoal, +Level)
If the goal has an associated cluster, make sure all the goals in the cluster are marked as completed. Recall that a cluster may consist of a number of "loops".
 2008% :-mode complete_cluster(+,+).
 2009
 2010complete_cluster( PGIndex, Level ) :-
 2011        get_loop( PGIndex, Gs ),                  % iterate over loops
 2012        member( G, Gs ),                        % iterate over members of a loop
 2013        complete_goal( G, Level ),
 2014        fail.
 2015
 2016complete_cluster( _, _ ).
 extract_goals(+ListOfTriplesOfGoalsWIndicesAndClauses, -ListOfGoals)
Filter away the other info in each triple, return list of goals only.
 2023% :-mode extract_goals(+,-).
 2024
 2025extract_goals( [], [] ).
 2026
 2027extract_goals( [ triple( G, _, _ ) | Ts ], [ G | Gs ] ) :-
 2028        extract_goals( Ts, Gs ).
 2029
 2030
 2031
 2032%-----  The tables: access and modification  -----
 2033
 2034% NOTE: See file dra_table_assert.pl or dra_table_record.pl for manipulation of
 2035%       the tables "answer", "result", "pioneer", "loop",
 2036%       "looping_alternative" and "completed".
 get_unique_index(-PGIndex)
Produce a new unique index.
 2042% :-mode get_unique_index(-).
 2043
 2044get_unique_index( PGIndex ) :-
 2045        dra_getval_flag( unique_index, PGIndex ),
 2046        dra_incval_flag( unique_index ).
 2047
 2048
 2049
 2050
 2051
 2052%-----  Custom-tailored utilities  -----
 are_essences_variants(+Term, +Term)
Are both the terms variants of each other after filtering through essence_hook?
 2059% :-mode are_essences_variants(+,+).
 2060
 2061are_essences_variants( T1, T2 ) :-
 2062        once( essence_hook( T1, ET1 ) ),
 2063        once( essence_hook( T2, ET2 ) ),
 2064        are_variants( ET1, ET2 ).
 trace_entry(+Label, +Goal, +PGIndex, +Level)
If the goal matches one of the traced patterns, print out a traces line about entering the goal (at this level, with this label). (The PGIndex is not always relevant: "?" is used for those cases.)
 2073trace_entry( Label, Goal, PGIndex, Level ) :-
 2074        is_traced( Goal ),
 2075        !,
 2076        write_level( Level ),
 2077        std_trace_stream( Output ),
 2078        dra_w( 'Entering ' ),
 2079        write_label_and_goal( Label, Goal, PGIndex ),
 2080        nl( Output ).
 2081
 2082trace_entry( _, _, _, _ ).
 trace_success(+Label, +Goal, +PGIndex, +Level)
If the goal matches one of the traced patterns, print out a traces line about success of the goal (at this level, with this label). Moreover, just before backtracking gets back to the goal, print out a traces line about retrying the goal. (The PGIndex is not always relevant: "?" is used for those cases.)
 2092trace_success( Label, Goal, PGIndex, Level ) :-
 2093        is_traced( Goal ),
 2094        !,
 2095        std_trace_stream( Output ),
 2096        (
 2097            write_level( Level ),
 2098            dra_w( 'Success ' ),
 2099            write_label_and_goal( Label, Goal, PGIndex ),
 2100            nl( Output )
 2101        ;
 2102            write_level( Level ),
 2103            dra_w( 'Retrying ' ),
 2104            write_label_and_goal( Label, Goal, PGIndex ),
 2105            nl( Output ),
 2106            fail
 2107        ).
 2108
 2109trace_success( _, _, _, _ ).
 trace_failure(+Label, +Goal, +PGIndex, +Level)
If the goal matches one of the traced patterns, print out a traces line about failure of the goal (at this level, with this label). (The PGIndex is not always relevant: "?" is used for those cases.)
 2117trace_failure( Label, Goal, PGIndex, Level ) :-
 2118        is_traced( Goal ),
 2119        !,
 2120        write_level( Level ),
 2121        std_trace_stream( Output ),
 2122        dra_w( 'Failing ' ),
 2123        write_label_and_goal( Label, Goal, PGIndex ),
 2124        nl( Output ).
 2125
 2126trace_failure( _, _, _, _ ).
 trace_other(+Label, +Goal, +PGIndex, +Level)
If the goal matches one of the traced patterns, print out a traces line about this goal (at this level, with this label). (The PGIndex is not always relevant: "?" is used for those cases.)
 2134trace_other( Label, Goal, PGIndex, Level ) :-
 2135        is_traced( Goal ),
 2136        !,
 2137        write_level( Level ),
 2138        write_label_and_goal( Label, Goal, PGIndex ),
 2139        std_trace_stream( Output ),
 2140        nl( Output ).
 2141
 2142trace_other( _, _, _, _ ).
 2143
 2144
 2145% Auxiliaries for tracing:
 2146
 2147write_level( Level ) :-dra_w([Level]).
 2148
 2149write_label_and_goal( Label, Goal, PGIndex ) :-
 2150        print_depth( Depth ),
 2151        std_trace_stream( Output ),
 2152        dra_w( Label ),
 2153        dra_w( ': ' ),
 2154        write_goal_number( PGIndex ),
 2155        write_shallow( Output, Goal, Depth ).
 2156
 2157
 2158write_goal_number( '?' ) :-
 2159        !.
 2160
 2161write_goal_number( PGIndex ) :-
 2162        dra_w( '<' ),
 2163        dra_w( PGIndex ),
 2164        dra_w( '> ' ).
 2165
 2166
 2167
 2168:-dynamic print_depth/1 . 2169
 2170print_depth( 10 ).
 optional_trace(+Label, +Goal, +Term, +Level)
If the goal matches one of the traced patterns, print out a traces line with this label, the goal and the term.
 2178optional_trace( Label, Goal, Term, Level ) :-
 2179        is_traced( Goal ),
 2180        !,
 2181        print_depth( Depth ),
 2182        write_level( Level ),
 2183        std_trace_stream( Output ),
 2184        write(         Output, Label ),
 2185        write_shallow( Output, Goal, Depth ),
 2186        write(         Output, ' : ' ),
 2187        write_shallow( Output, Term, Depth ),
 2188        nl(            Output ).
 2189
 2190optional_trace( _, _, _, _ ).
 2191
 2192
 2193
 2194
 2195
 2196% c +R = 7.949 seconds
 2197
 2198
 2199% :-repeat,logOnErrorIgnore(prolog),fail.
 2200% user:term_expansion((?- G),_):-nonvar(G), format(atom(H),'~q .',[G]),user:rl_add_history(H),fail.
 2201% user:goal_expansion(G,_):-G\=(_,_),G\=(_;_),\+ predicate_property(G,_),format(atom(H),'~q .',[G]),user:rl_add_history(H),fail.
 2202
 2203
 2204
 2205
 2206
 2207
 2208
 2209
 2210
 2211
 2212
 2213
 2214
 2215
 2216
 2217
 2218
 2219
 2220
 2221
 2222
 2223
 2224
 2225
 2226
 2227
 2228
 2229
 2230:- if(\+ current_predicate(tabling_store/1);\+tabling_store(_)). 2231:- dynamic(tabling_store/1). 2232tabling_store(assert).
 2233% tabling_store(record).
 2234:- endif. 2235
 2236
 2237
 2238
 2239
 2240
 2241
 2242/**/
 2243:- if(tabling_store(hybrid);true). 2244/*  Part of SWI-Prolog
 2245
 2246    Author:        Douglas R. Miles
 2247    E-mail:        logicmoo@gmail.com
 2248    WWW:           http://www.swi-prolog.org http://www.prologmoo.com
 2249    Copyright (C): 2015, University of Amsterdam
 2250                                    VU University Amsterdam
 2251
 2252    This program is free software; you can redistribute it and/or
 2253    modify it under the terms of the GNU General Public License
 2254    as published by the Free Software Foundation; either version 2
 2255    of the License, or (at your option) any later version.
 2256
 2257    This program is distributed in the hope that it will be useful,
 2258    but WITHOUT ANY WARRANTY; without even the implied warranty of
 2259    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 2260    GNU General Public License for more details.
 2261
 2262    You should have received a copy of the GNU General Public
 2263    License along with this library; if not, write to the Free Software
 2264    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 2265
 2266    As a special exception, if you link this library with other files,
 2267    compiled with a Free Software compiler, to produce an executable, this
 2268    library does not by itself cause the resulting executable to be covered
 2269    by the GNU General Public License. This exception does not however
 2270    invalidate any other reasons why the executable file might be covered by
 2271    the GNU General Public License.
 2272
 2273*/
 2274   % NOTICE: %%%%%%%%%%%%%%%%
 2275   %                                                                      %
 2276   %  COPYRIGHT (2009) University of Dallas at Texas.                     %
 2277   %                                                                      %
 2278   %  Developed at the Applied Logic, Programming Languages and Systems   %
 2279   %  (ALPS) Laboratory at UTD by Feliks Kluzniak.                        %
 2280   %                                                                      %
 2281   %  Permission is granted to modify this file, and to distribute its    %
 2282   %  original or modified contents for non-commercial purposes, on the   %
 2283   %  condition that this notice is included in all copies in its         %
 2284   %  original form.                                                      %
 2285   %                                                                      %
 2286   %  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,     %
 2287   %  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES     %
 2288   %  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE AND     %
 2289   %  NON-INFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR        %
 2290   %  ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE FOR ANY DAMAGES OR       %
 2291   %  OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, ARISING    %
 2292   %  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR       %
 2293   %  OTHER DEALINGS IN THE SOFTWARE.                                     %
 2294   %                                                                      %
 2295   %
 2296
 2297%  Table-handling procedures for the "dra" interpreter.                    %
 2298%                                                                          %
 2299%  Written by Feliks Kluzniak at UTD (March 2009)           .              %
 2300%                                                                          %
 2301%  Last update: 25-27 August 2009.                                            %
 2302%                                                                          %
 2303
 2304% The tables are normally kept in asserted clauses, but for some systems this
 2305% is  not convenient, because asserted clauses are compiled.
 2306% For example, this is so in SWI Prolog, which in addition does not assert
 2307% cyclic terms, so  for that system the "recorded" database is more
 2308% appropriate.
 2309% In order to facilitate such changes, routines for handling the table is
 2310% factored out of the main program.
 2311
 2312
 2313% >>>>>>>>>  This version for systems that use the recorded database. <<<<<<<<<
 2314% >>>>>>>>>  This version for systems that use assert/1. <<<<<<<<<
 2315
 2316
 2317%------------------------------------------------------------------------------
Make sure that the item is recorded in the database.
 2322ensure_recorded( Key, Item ) :-
 2323        (
 2324            recorded( Key, Item )
 2325        ->
 2326            true
 2327        ;
 2328            recordz( Key, Item )
 2329        ).
 2330
 2331:-dynamic answer/3 . 2332:-dynamic pioneer/3 . 2333:-dynamic result/2 . 2334:-dynamic loop/2 . 2335:-dynamic looping_alternative/2 . 2336:-dynamic completed/2 . 2337
 2338print_tables :-
 2339       recorded_listing( answer( _, _, _ ) ),
 2340       recorded_listing( result( _, _ ) ),
 2341       recorded_listing( pioneer( _, _, _ ) ),
 2342       recorded_listing( loop( _, _ ) ),
 2343       recorded_listing( looping_alternative( _, _ ) ),
 2344       recorded_listing( completed( _, _ ) ).
 2345
 2346
 2347recorded_listing(G):-
 2348   (current_predicate(_,G)->listing(G);true),
 2349   forall(recorded(G,A),dra_wln(G->A)),
 2350   forall(recorded(A,G),dra_wln(A->G)),!.
 2351
 2352%------------------------------------------------------------------------------
 2353
 2354% Each item recorded for table "answer" is of the form
 2355% "answer( Filter, Goal, Fact )", where "Filter" is the essence of a copy of
 2356% "Goal".
 2357% The item is recorded under the key "Goal" , i.e., effectively the key is the
 2358% principal functor of the goal.  A most general instance of the key is
 2359% additionally recorded under the key "answer_key".
 2360
 2361
 2362% Clear all known answers (and keys).
 2363
 2364reinitialise_answer :- tabling_store(assert),!,
 2365        retractall( answer( _, _, _ ) ).
 2366
 2367reinitialise_answer :-
 2368        recorded( answer_key, Key, RefKey ),
 2369        erase( RefKey ),
 2370        recorded( Key, answer( _, _, _ ), RefAnswer ),
 2371        erase( RefAnswer ),
 2372        fail.
 2373
 2374reinitialise_answer.
 is_answer_known(+Goal, +Fact)
Does the table "answer" contain a variant of this fact paired with a variant of this goal?
 2380% :-mode is_answer_known(+,+).
 2381
 2382is_answer_known( Goal, Fact ) :- tabling_store(assert),!,
 2383        copy_term( Goal, Copy ),
 2384        once( essence_hook( Copy, CopyEssence ) ),
 2385        answer( CopyEssence, G, F ),
 2386        are_essences_variants( G, Goal ),
 2387        are_essences_variants( F, Fact ),
 2388        !.
 2389
 2390is_answer_known( Goal, Fact ) :-
 2391        copy_term( Goal, Copy ),
 2392        once( essence_hook( Copy, CopyEssence ) ),
 2393        recorded( Goal, answer( CopyEssence, G, F ) ),
 2394        are_essences_variants( G, Goal ),
 2395        are_essences_variants( F, Fact ),
 2396        !.
If the table "answer" does not contain a variant of this fact paired with a variant of this goal, then add the pair to the table, increasing "number_of_answers".
 2404% :-mode memo(+,+,+).
 2405
 2406memo( Goal, Fact, _ ) :-
 2407        is_answer_known( Goal, Fact ),
 2408        !.
 2409
 2410memo( Goal, Fact, Level ) :- tabling_store(assert),!,
 2411        % \+ is_answer_known( Goal, Fact ),
 2412        optional_trace( 'Storing answer: ', Goal, Fact, Level ),
 2413        copy_term( Goal, Copy ),
 2414        once( essence_hook( Copy, CopyEssence ) ),
 2415        assert( answer( CopyEssence, Goal, Fact ) ),
 2416        dra_incval_flag( number_of_answers ).
 2417
 2418
 2419memo( Goal, Fact, Level ) :-
 2420        % \+ is_answer_known( Goal, Fact ),
 2421        optional_trace( 'Storing answer: ', Goal, Fact, Level ),
 2422        copy_term( Goal, Copy ),
 2423        once( essence_hook( Copy, CopyEssence ) ),
 2424        recordz( Goal, answer( CopyEssence, Goal, Fact ) ),
 2425        most_general_instance( Goal, Key ),
 2426        ensure_recorded( answer_key, Key ),
 2427        dra_incval_flag( number_of_answers ).
 2428
 2429%------------------------------------------------------------------------------
 2430%% most_general_instance(+Term,-MostGeneralInstanceSameFunctor)
 2431% E.g., p( a, q( X, Y ) )  is transformed to  p( _, _ ).
 2432
 2433% :-mode most_general_instance( +, -).
 2434
 2435most_general_instance( Term, Pattern ) :-
 2436        functor( Term, Name, Arity ),
 2437        functor( Pattern, Name, Arity ).
Get an instantiation (if any) tabled in "answer" for variants of this goal. Sequence through all such instantiations on backtracking.
 2445% :-mode get_answer( ? ).
 2446
 2447get_answer( Goal ) :- tabling_store(assert),!,
 2448        once( essence_hook( Goal, EssenceOfGoal ) ),
 2449        copy_term( Goal, Copy ),
 2450        once( essence_hook( Copy, CopyEssence ) ),
 2451        answer( CopyEssence, G, Ans ),
 2452        once( essence_hook( G, EssenceOfG ) ),
 2453        are_variants( EssenceOfGoal, EssenceOfG ),
 2454        EssenceOfGoal = EssenceOfG,     % make sure variables are the right ones
 2455        once( essence_hook( Ans, EssenceOfAns ) ),
 2456        EssenceOfGoal = EssenceOfAns .  % instantiate
 2457
 2458get_answer( Goal ) :-
 2459        copy_term( Goal, Copy ),
 2460        once( essence_hook( Copy, CopyEssence ) ),
 2461        once( essence_hook( Goal, EssenceOfGoal ) ),
 2462        recorded( Goal, answer( CopyEssence, G, Ans ) ),
 2463        once( essence_hook( G, EssenceOfG ) ),
 2464        are_variants( EssenceOfGoal, EssenceOfG ),
 2465        EssenceOfGoal = EssenceOfG,     % make sure variables are the right ones
 2466        once( essence_hook( Ans, EssenceOfAns ) ),
 2467        EssenceOfGoal = EssenceOfAns .  % instantiate
 get_all_tabled_goals(-ListOfGoals)
Get all the goals that were tabled together with their answers.
 2473get_all_tabled_goals( Goals ) :- tabling_store(assert),!,
 2474        findall( Goal, answer( _, Goal, _ ), Goals ).
 2475
 2476get_all_tabled_goals( Goals ) :-
 2477        findall( Goal,
 2478                 (recorded( answer_key, Key ),
 2479                  recorded( Key, answer( _, Goal, _ ) )
 2480                 ),
 2481                 Goals
 2482               ).
 2483
 2484
 2485
 2486%------------------------------------------------------------------------------
 2487
 2488% Each item recorded for table "result" is of the form "result( Fact )".
 2489% The item is recorded under the key "PGIndex".  The index is additionally
 2490% recorded under the key "result_key".
 2491
 2492% reinitialise_result:
 2493% Clear the result table.
 2494
 2495reinitialise_result :-  tabling_store(assert),!,
 2496        retractall( result( _, _ ) ).
 2497
 2498reinitialise_result :-
 2499
 2500        recorded( result_key, PGIndex, RefIndex ),
 2501        erase( RefIndex ),
 2502        recorded( PGIndex, result( _ ), RefResult ),
 2503        erase( RefResult ),
 2504        fail.
 2505
 2506reinitialise_result.
Does the table "result" contain a variant of this fact associated with this index?
 2513% :-mode is_result_known(+,+).
 2514
 2515is_result_known( PGIndex, Fact ) :- tabling_store(assert),!,
 2516        result( PGIndex, F ),
 2517        are_essences_variants( F, Fact ),
 2518        !.
 2519
 2520is_result_known( PGIndex, Fact ) :-
 2521        recorded( PGIndex, result( F ) ),
 2522        are_essences_variants( F, Fact ),
 2523        !.
 new_result_or_fail(+PGIndex, +Fact)
If the table "result" already contains a variant of this fact associated with this index, then fail. Otherwise record the fact in the table and succeed.
 2530% :-mode new_result_or_fail(+,+).
 2531
 2532new_result_or_fail( PGIndex, Fact ) :- tabling_store(assert),!,
 2533        \+ is_result_known( PGIndex, Fact ),
 2534        assert( result( PGIndex, Fact ) ).
 2535
 2536new_result_or_fail( PGIndex, Fact ) :-
 2537        \+ is_result_known( PGIndex, Fact ),
 2538        recordz( PGIndex, result( Fact ) ),
 2539        ensure_recorded( result_key, PGIndex ).
 2540
 2541
 2542
 2543%------------------------------------------------------------------------------
 2544% Each item recorded for table "pioneer" is of the form
 2545% "pioneer( Filter, Goal, PGIndex )" (where "PGIndex" is unique and "Filter" is the
 2546% essence of a copy of "Goal".
 2547% The item is recorded under the key "Goal" , i.e., effectively the key is the
 2548% principal functor of the goal.  A most general instance of the goal is
 2549% additionally  recorded under the key "pioneer_key".
 2550% Moreover, to speed up delete_pioneer/1, the key is recorded also as
 2551% "pioneer_goal( Key )" under the key "PGIndex".
 2552
 2553
 2554% reinitialise_pioneer:
 2555% Clear the table of pioneers.
 2556
 2557reinitialise_pioneer :- tabling_store(assert),!,
 2558        retractall( pioneer( _, _, _ ) ).
 2559
 2560reinitialise_pioneer :-
 2561        recorded( pioneer_key, Key, RefIndex ),
 2562        erase( RefIndex ),
 2563        recorded( Key, pioneer( _, _, _ ), RefResult ),
 2564        erase( RefResult ),
 2565        fail.
 2566
 2567reinitialise_pioneer.
 is_a_variant_of_a_pioneer(+Goal, -PGIndex)
Succeeds if the goal is a variant of a goal that is tabled in "pioneer"; returns the index of the relevant entry in table "pioneer".
 2574% :-mode is_a_variant_of_a_pioneer(+,-).
 2575
 2576is_a_variant_of_a_pioneer( Goal, PGIndex ) :- tabling_store(assert),!,
 2577        copy_term( Goal, Copy ),
 2578        once( essence_hook( Copy, CopyEssence ) ),
 2579        pioneer( CopyEssence, G, PGIndex ),
 2580        are_essences_variants( Goal, G ),
 2581        !.
 2582
 2583is_a_variant_of_a_pioneer( Goal, PGIndex ) :-
 2584        copy_term( Goal, Copy ),
 2585        once( essence_hook( Copy, CopyEssence ) ),
 2586        recorded( Goal, pioneer( CopyEssence, G, PGIndex ) ),
 2587        are_essences_variants( Goal, G ),
 2588        !.
Add an entry for this goal to "pioneer", return the unique index.
 2594% :-mode add_pioneer(+,-).
 2595
 2596add_pioneer( Goal, PGIndex ) :- tabling_store(assert),!,
 2597        copy_term( Goal, Copy ),
 2598        once( essence_hook( Copy, CopyEssence ) ),
 2599        get_unique_index( PGIndex ),
 2600        assert( pioneer( CopyEssence, Goal, PGIndex ) ).
 2601
 2602add_pioneer( Goal, PGIndex ) :-
 2603        get_unique_index( PGIndex ),
 2604        copy_term( Goal, Copy ),
 2605        once( essence_hook( Copy, CopyEssence ) ),
 2606        recordz( Goal, pioneer( CopyEssence, Goal, PGIndex ) ),
 2607        most_general_instance( Goal, Key ),
 2608        ensure_recorded( pioneer_key, Key ),
 2609        recordz( PGIndex, pioneer_goal( Key ) ).
 delete_pioneer(+PGIndex)
Remove the entry in "pioneer" associated with this index.
 2615% :-mode delete_pioneer( + ).
 2616
 2617delete_pioneer( PGIndex ) :- tabling_store(assert),!,
 2618        retract( pioneer( _, _, PGIndex )).
 2619
 2620delete_pioneer( PGIndex ) :-
 2621        recorded( PGIndex, pioneer_goal( Key ), RefIndex ),
 2622        erase( RefIndex ),
 2623        recorded( Key, pioneer( _, _, PGIndex ), RefPioneer ),
 2624        erase( RefPioneer ).
 2625
 2626
 2627
 2628%-------------------------------------------------------------------------------
 2629
 2630% Each item recorded for table "loop" is of the form "loop( Goals )".
 2631% The item is recorded under the key "PGIndex", where "PGIndex" is the index
 2632% associated with the loop.
 2633% The index is additionally recorded under the key "loop_key".
 2634
 2635
 2636% reinitialise_loop:
 2637% Clear the table of pioneers.
 2638
 2639reinitialise_loop :- tabling_store(assert),!,
 2640        retractall( loop( _, _ ) ).
 2641
 2642reinitialise_loop :-
 2643        recorded( loop_key, PGIndex, RefIndex ),
 2644        erase( RefIndex ),
 2645        delete_loops( PGIndex ),
 2646        fail.
 2647
 2648reinitialise_loop.
 add_loop(+PGIndex, +ListOfGoals)
Add an entry to "loop".
 2654% :-mode add_loop(+,+).
 2655
 2656add_loop( _, [] ) :-                           % empty loops are not stored
 2657        !.
 2658
 2659add_loop( PGIndex, Goals ) :-                    % neither are duplicates
 2660        get_loop( PGIndex, Gs ),
 2661        are_variants( Goals, Gs ),
 2662        !.
 2663
 2664add_loop( PGIndex, Goals ) :- tabling_store(assert),!,
 2665        assert( loop( PGIndex, Goals ) ).
 2666
 2667add_loop( PGIndex, Goals ) :-
 2668        recordz( PGIndex, loop( Goals ) ),
 2669        ensure_recorded( loop_key, PGIndex ).
 delete_loops(+PGIndex)
Remove all the entries in "loop" that are associated with this index.
 2674delete_loops( PGIndex ) :- tabling_store(assert),!,
 2675        retractall( loop( PGIndex, _ ) ).
 2676
 2677delete_loops( PGIndex ) :-
 2678        recorded( PGIndex, loop( _ ), RefLoop ),
 2679        erase( RefLoop ),
 2680        fail.
 2681
 2682delete_loops( _ ).
 get_loop(+PGIndex, -Goals)
Get an entry from table "loop" that is associated with this index; another such entry (if it exists) on backtracking etc.
 2691get_loop( PGIndex, Gs ) :- tabling_store(assert),!,
 2692        loop( PGIndex, Gs ).
 2693
 2694get_loop( PGIndex, Gs ) :-
 2695        recorded( PGIndex, loop( Gs ) ).
 2696
 2697
 2698
 2699%-------------------------------------------------------------------------------
 2700
 2701% Each item recorded for table "looping_alternative" is of the form
 2702% "looping_alternative( Clause )".
 2703% The item is recorded under the key "PGIndex", where "PGIndex" is the index
 2704% associated with the looping_alternative.
 2705% The index is additionally recorded under the key "looping_alternative_key".
 2706
 2707
 2708% reinitialise_looping_alternative:
 2709% Clear the table of pioneers.
 2710
 2711reinitialise_looping_alternative :- tabling_store(assert),!,
 2712        retractall( looping_alternative( _, _ ) ).
 2713
 2714reinitialise_looping_alternative :-
 2715        recorded( looping_alternative_key, PGIndex, RefIndex ),
 2716        erase( RefIndex ),
 2717        delete_looping_alternatives( PGIndex ),
 2718        fail.
 2719
 2720reinitialise_looping_alternative.
 add_looping_alternative(+PGIndex, +Clause)
Add and entry to "looping_alternative".
 2726% :-mode add_looping_alternative(+,+).
 2727
 2728add_looping_alternative( PGIndex, Clause ) :-     % duplicates are not stored
 2729        get_looping_alternative( PGIndex, C ),
 2730        are_variants( Clause, C ),
 2731        !.
 2732
 2733add_looping_alternative( PGIndex, Clause ) :- tabling_store(assert),!,
 2734        assert( looping_alternative( PGIndex, Clause ) ).
 2735
 2736add_looping_alternative( PGIndex, Clause ) :-
 2737        recordz( PGIndex, looping_alternative( Clause ) ),
 2738        ensure_recorded( looping_alternative_key, PGIndex ).
 delete_looping_alternatives(+PGIndex)
Remove all the entries in "loop" that are associated with this index.
 2744delete_looping_alternatives( PGIndex ) :- tabling_store(assert),!,
 2745        retractall( looping_alternative( PGIndex, _ ) ).
 2746
 2747delete_looping_alternatives( PGIndex ) :-
 2748        recorded( PGIndex, looping_alternative( _ ), RefLoop ),
 2749        erase( RefLoop ),
 2750        fail.
 2751
 2752delete_looping_alternatives( _ ).
 get_looping_alternative(+PGIndex, -Clause)
Get an entry from table "looping_alternative" that is associated with this index; another such entry (if it exists) on backtracking etc.
 2761get_looping_alternative( PGIndex, Clause ) :- tabling_store(assert),!,
 2762        looping_alternative( PGIndex, Clause ).
 2763
 2764get_looping_alternative( PGIndex, Clause ) :-
 2765        recorded( PGIndex, looping_alternative( Clause ) ).
 2766
 2767
 2768
 2769%-------------------------------------------------------------------------------
 2770
 2771% Each item recorded for table "completed" is of the form
 2772% "completed( Filter, Goal )", where "Filter" is the essence of a copy of
 2773% "Goal".
 2774% The item is recorded under the key "Goal" , i.e., effectively the key is the
 2775% principal functor of the goal.  A most general instance of the goal is
 2776% additionally recorded under the key "completed_key".
 2777
 2778
 2779% reinitialise_completed:
 2780% Clear the table of completed goals.
 2781
 2782reinitialise_completed :- tabling_store(assert),!,
 2783        retractall( completed( _, _ ) ).
 2784
 2785reinitialise_completed :-
 2786        recorded( completed_key, Key , RefIndex ),
 2787        erase( RefIndex ),
 2788        recorded( Key, completed( _, _ ), RefResult ),
 2789        erase( RefResult ),
 2790        fail.
 2791
 2792reinitialise_completed.
 is_completed(+Goal)
Succeeds iff the goal is a variant of a goal that has been stored in the table "completed".
 2799% :-mode is_completed(+).
 2800
 2801is_completed( Goal ) :- tabling_store(assert),!,
 2802        copy_term( Goal, Copy ),
 2803        once( essence_hook( Copy, CopyEssence ) ),
 2804        completed( CopyEssence, G ),
 2805        are_essences_variants( Goal, G ).
 2806
 2807is_completed( Goal ) :-
 2808        copy_term( Goal, Copy ),
 2809        once( essence_hook( Copy, CopyEssence ) ),
 2810        recorded( Goal, completed( CopyEssence, G ) ),
 2811        are_essences_variants( Goal, G ).
 complete_goal(+Goal, +IndexFortracing)
Make sure the goal is marked as completed.
 2816% :-mode complete_goal(+,+).
 2817
 2818complete_goal( Goal, _ ) :-
 2819        is_completed( Goal ),
 2820        !.
 2821
 2822complete_goal( Goal, Level ) :- tabling_store(assert),!,
 2823        % \+ is_completed( Goal ),
 2824        copy_term( Goal, Copy ),
 2825        once( essence_hook( Copy, CopyEssence ) ),
 2826        trace_other( 'Completing', Goal, '?', Level ),
 2827        assert( completed( CopyEssence, Goal ) ).
 2828complete_goal( Goal, Level ) :-
 2829        % \+ is_completed( Goal ),
 2830        copy_term( Goal, Copy ),
 2831        once( essence_hook( Copy, CopyEssence ) ),
 2832        trace_other( 'Completing', Goal, '?', Level ),
 2833        recordz( Goal, completed( CopyEssence, Goal ) ),
 2834        most_general_instance( Goal, Key ),
 2835        ensure_recorded( completed_key, Key ).
 2836
 2837
 2838%-------------------------------------------------------------------------------
 2839
 2840:- endif. 2841
 2842
 2843
 2844
 2845
 2846
 2847
 2848
 2849:-source_location(S,_),prolog_load_context(module,FM),
 2850 forall(source_file(M:H,S),
 2851  ignore((functor(H,F,A),
 2852   \+ atom_concat('$',_,F),
 2853      M:export(M:F/A),
 2854   \+ predicate_property(M:H,transparent),
 2855%    dra_w(M:H),
 2856   \+ atom_concat('__aux',_,F), FM:module_transparent(M:F/A)))). 2857
 2858
 2859:- retract(was_access_level(Was)),set_prolog_flag(access_level,Was). 2860
 2861
 2862
 2863
 2864:- if(fail). 2865% Comment this for source maintainance
 2866:- make. 2867:- check. 2868:- gxref. 2869:- listing(tnot). 2870:- listing(table). 2871:- endif.