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]).
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:
Here, "new answer for a tabled goal" means an answer that has not yet been seen (and tabled) for a variant of the goal.
The default behaviour is intended to help computations converge more quickly. The user is given an option to change it, because some predicates may produce a very large (even infinite) set of answers on backtracking, and the application might not require those answers.
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: -----------
:- use_module(library(dra))."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( _, _ ).
[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.
dra_builtins.pl").
Every addition should be considered carefully: some built-ins might
require special treatment by the interpreter.
essence_hook( T, T ).
This predicate is invoked in certain contexts when:
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( dra_w( _, _ ) ).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( D )"
to give the interpreter a chance to act upon the
directive.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 )
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.
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(). 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):- *->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(,, ,)). 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(,,, , ,)). 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)
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(,). 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))).
ancestors(stack) and the chain of coinductive0 ancestors
(coinductive hypotheses). The level is the level of recursion, and is used
only for tracing.
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(,,,,). 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 ).
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
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 ).
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).
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 ).
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( _, _ ).
1995% :-mode rescind_pioneer_status(+). 1996 1997rescind_pioneer_status( PGIndex ) :- 1998 delete_pioneer( PGIndex ), 1999 delete_loops( PGIndex ), 2000 delete_looping_alternatives( PGIndex ).
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( _, _ ).
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".
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 -----
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 ).
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( _, _, _, _ ).
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( _, _, _, _ ).
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( _, _, _, _ ).
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 ).
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%------------------------------------------------------------------------------
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.
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 !.
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 ).
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
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.
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 !.
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.
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 !.
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 ) ).
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.
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 ).
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( _ ).
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.
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 ).
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( _ ).
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.
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 ).
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.