update chr
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2143 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
785ddd56af
commit
d02bc3de81
C
CLPBN/clpbn
GPL
H
LGPL
Makefile.inapply_macros.pl
Makefile.inchr
builtins.plchr_compiler_errors.plchr_compiler_options.plchr_compiler_utility.plchr_debug.plchr_hashtable_store.plchr_integertable_store.plchr_messages.plchr_op.plchr_op2.plchr_runtime.plchr_swi.plchr_swi_bootstrap.plchr_test.plchr_translate.chrchr_translate_bootstrap.plchr_translate_bootstrap1.chrchr_translate_bootstrap2.chrclean_code.plfind.plguard_entailment.plhprolog.pllistmap.pl
library
pl
@ -11,8 +11,12 @@
|
||||
* File: compiler.c *
|
||||
* comments: Clause compiler *
|
||||
* *
|
||||
* Last rev: $Date: 2007-12-18 17:46:58 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-03-13 14:37:58 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.87 2007/12/18 17:46:58 vsc
|
||||
* purge_clauses does not need to do anything if there are no clauses
|
||||
* fix gprof bugs.
|
||||
*
|
||||
* Revision 1.86 2007/11/26 23:43:08 vsc
|
||||
* fixes to support threads and assert correctly, even if inefficiently.
|
||||
*
|
||||
@ -1871,7 +1875,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (p->PredFlags & (CPredFlag | AsmPredFlag)) {
|
||||
if (p->PredFlags & (CPredFlag | AsmPredFlag | ModuleTransparentPredFlag)) {
|
||||
#ifdef YAPOR
|
||||
if (p->PredFlags & SyncPredFlag)
|
||||
Yap_emit(sync_op, (CELL)p, (CELL)(p->ArityOfPE), &cglobs->cint);
|
||||
|
||||
23
C/modules.c
23
C/modules.c
@ -242,6 +242,28 @@ p_strip_module(void)
|
||||
Yap_unify(ARG2, tmod);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_context_module(void)
|
||||
{
|
||||
yamop *parentcp = P;
|
||||
CELL *yenv;
|
||||
PredEntry *ap = EnvPreg(parentcp);
|
||||
if (ap->ModuleOfPred &&
|
||||
!(ap->PredFlags & MetaPredFlag))
|
||||
return Yap_unify(ARG1, ap->ModuleOfPred);
|
||||
parentcp = CP;
|
||||
yenv = ENV;
|
||||
do {
|
||||
ap = EnvPreg(parentcp);
|
||||
if (ap->ModuleOfPred &&
|
||||
!(ap->PredFlags & MetaPredFlag))
|
||||
return Yap_unify(ARG1, ap->ModuleOfPred);
|
||||
parentcp = (yamop *)yenv[E_CP];
|
||||
yenv = (CELL *)yenv[E_E];
|
||||
} while(yenv);
|
||||
return Yap_unify(ARG1, CurrentModule);
|
||||
}
|
||||
|
||||
void
|
||||
Yap_InitModulesC(void)
|
||||
{
|
||||
@ -249,6 +271,7 @@ Yap_InitModulesC(void)
|
||||
Yap_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("context_module", 1, p_context_module, 0);
|
||||
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
|
||||
SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
}
|
||||
|
||||
@ -2086,6 +2086,26 @@ cont_current_atom(void)
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_unifiable(void)
|
||||
{
|
||||
tr_fr_ptr trp;
|
||||
Term tf = TermNil;
|
||||
if (!Yap_unify(ARG1,ARG2)) {
|
||||
return FALSE;
|
||||
}
|
||||
trp = TR;
|
||||
while (trp != B->cp_tr) {
|
||||
Term t[2];
|
||||
--trp;
|
||||
t[0] = TrailTerm(trp);
|
||||
t[1] = *(CELL *)t[0];
|
||||
tf = MkPairTerm(Yap_MkApplTerm(FunctorEq,2,t),tf);
|
||||
RESET_VARIABLE(t[0]);
|
||||
}
|
||||
return Yap_unify(ARG3, tf);
|
||||
}
|
||||
|
||||
void Yap_InitUtilCPreds(void)
|
||||
{
|
||||
Term cm = CurrentModule;
|
||||
@ -2102,6 +2122,7 @@ void Yap_InitUtilCPreds(void)
|
||||
Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
|
||||
Yap_InitCPred("variant", 2, p_variant, 0);
|
||||
Yap_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
|
||||
Yap_InitCPred("protected_unifiable", 3, p_unifiable, 0);
|
||||
CurrentModule = cm;
|
||||
#ifdef DEBUG
|
||||
Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag|HiddenPredFlag);
|
||||
|
||||
@ -2,10 +2,12 @@
|
||||
% distribution
|
||||
%
|
||||
|
||||
:- module(clpbn_dist,[
|
||||
:- module(clpbn_dist,
|
||||
[
|
||||
dist/1,
|
||||
dist/3,
|
||||
dists/1,
|
||||
dist_new_table/2,
|
||||
get_dist/4,
|
||||
get_dist_matrix/5,
|
||||
get_dist_domain/2,
|
||||
@ -14,13 +16,17 @@
|
||||
get_dist_tparams/2,
|
||||
get_evidence_position/3,
|
||||
get_evidence_from_position/3,
|
||||
dist_to_term/2
|
||||
dist_to_term/2,
|
||||
empty_dist/2,
|
||||
dist_new_table/2
|
||||
]).
|
||||
|
||||
:- use_module(library(lists),[is_list/1,nth0/3]).
|
||||
|
||||
:- use_module(library(matrix),
|
||||
[matrix_new/4,
|
||||
matrix_new/3,
|
||||
matrix_to_list/2,
|
||||
matrix_to_logs/1]).
|
||||
|
||||
|
||||
@ -95,49 +101,58 @@ dist(p(Type, CPT), Id, FParents) :-
|
||||
distribution(bool, trans(CPT), Id, Parents, FParents) :-
|
||||
is_list(CPT), !,
|
||||
compress_hmm_table(CPT, Parents, Tab, FParents),
|
||||
add_dist([t,f], trans, Tab, Id).
|
||||
add_dist([t,f], trans, Tab, ParentsId).
|
||||
distribution(bool, CPT, Id, Parents, Parents) :-
|
||||
is_list(CPT), !,
|
||||
add_dist([t,f], tab, CPT, Id).
|
||||
distribution(aminoacids, trans(CPT), Id, Parents, FParents) :-
|
||||
is_list(CPT), !,
|
||||
compress_hmm_table(CPT, Parents, Tab, FParents),
|
||||
add_dist([a,c,d,e,f,g,h,i,k,l,m,n,p,q,r,s,t,v,w,y], trans, Tab, Id).
|
||||
add_dist([a,c,d,e,f,g,h,i,k,l,m,n,p,q,r,s,t,v,w,y], trans, Tab, FParents, Id).
|
||||
distribution(aminoacids, CPT, Id, Parents, Parents) :-
|
||||
is_list(CPT), !,
|
||||
add_dist([a,c,d,e,f,g,h,i,k,l,m,n,p,q,r,s,t,v,w,y], tab, CPT, Id).
|
||||
add_dist([a,c,d,e,f,g,h,i,k,l,m,n,p,q,r,s,t,v,w,y], tab, CPT, Parents, Id).
|
||||
distribution(dna, trans(CPT), Id, Parents, FParents) :-
|
||||
is_list(CPT), !,
|
||||
compress_hmm_table(CPT, Parents, Tab, FParents),
|
||||
add_dist([a,c,g,t], trans, Tab, Id).
|
||||
add_dist([a,c,g,t], trans, Tab, FParents, Id).
|
||||
distribution(dna, CPT, Id, Parents, Parents) :-
|
||||
is_list(CPT), !,
|
||||
add_dist([a,c,g,t], tab, CPT, Id).
|
||||
distribution(rna, trans(CPT), Id, Parents, FParents) :-
|
||||
is_list(CPT), !,
|
||||
compress_hmm_table(CPT, Parents, Tab, FParents),
|
||||
compress_hmm_table(CPT, Parents, Tab, FParents, FParents),
|
||||
add_dist([a,c,g,u], trans, Tab, Id).
|
||||
distribution(rna, CPT, Id, Parents, Parents) :-
|
||||
is_list(CPT), !,
|
||||
add_dist([a,c,g,u], tab, CPT, Id).
|
||||
add_dist([a,c,g,u], tab, CPT, Parents, Id).
|
||||
distribution(Domain, trans(CPT), Id, Parents, FParents) :-
|
||||
is_list(Domain),
|
||||
is_list(CPT), !,
|
||||
compress_hmm_table(CPT, Parents, Tab, FParents),
|
||||
add_dist(Domain, trans, Tab, Id).
|
||||
add_dist(Domain, trans, Tab, FParents, Id).
|
||||
distribution(Domain, CPT, Id, Parents, Parents) :-
|
||||
is_list(Domain),
|
||||
is_list(CPT), !,
|
||||
add_dist(Domain, tab, CPT, Id).
|
||||
add_dist(Domain, tab, CPT, Parents, Id).
|
||||
|
||||
add_dist(Domain, Type, CPT, Id) :-
|
||||
add_dist(Domain, Type, CPT, _, Id) :-
|
||||
recorded(clpbn_dist_db, db(Id, CPT, Type, Domain, _, _), _), !.
|
||||
add_dist(Domain, Type, CPT, Id) :-
|
||||
add_dist(Domain, Type, CPT, PSizes, Id) :-
|
||||
length(CPT, CPTSize),
|
||||
length(Domain, DSize),
|
||||
new_id(Id),
|
||||
record_parent_sizes(Parents, Id, PSizes, [DSize|PSizes]),
|
||||
recordz(clpbn_dist_db,db(Id, CPT, Type, Domain, CPTSize, DSize),_).
|
||||
|
||||
|
||||
record_parent_sizes([], Id, [], DSizes) :-
|
||||
recordz(clpbn_dist_psizes,db(Id, DSizes),_).
|
||||
record_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :-
|
||||
clpbn:get_atts(P,dist(Dist,_)),
|
||||
get_dist_domain_size(Dist, DSize),
|
||||
record_parent_sizes(Parents, Id, Sizes, DSizes).
|
||||
|
||||
%
|
||||
% Often, * is used to code empty in HMMs.
|
||||
%
|
||||
@ -197,3 +212,17 @@ get_evidence_from_position(El, Id, Pos) :-
|
||||
throw(error(domain_error(no_distribution,Id),get_evidence_from_position(El, Id, Pos))).
|
||||
|
||||
dist_to_term(_Id,_Term).
|
||||
|
||||
empty_dist(Dist, TAB) :-
|
||||
recorded(clpbn_dist_psizes,db(Dist, DSizes),_),
|
||||
matrix_new(floats, DSizes, TAB).
|
||||
|
||||
dist_new_table(Id, NewMAT) :-
|
||||
matrix_to_list(NewMat, List),
|
||||
recorded(clpbn_dist_db, db(Id, _, A, B, C, D), R),
|
||||
erase(R),
|
||||
recorda(clpbn_dist_db, db(Id, List, A, B, C, D), R),
|
||||
fail.
|
||||
dist_new_table(_, _).
|
||||
|
||||
|
||||
|
||||
@ -52,19 +52,32 @@
|
||||
check_if_vel_done(Var) :-
|
||||
get_atts(Var, [size(_)]), !.
|
||||
|
||||
%
|
||||
% implementation of the well known variable elimination algorithm
|
||||
%
|
||||
vel([],_,_) :- !.
|
||||
vel(LVs,Vs0,AllDiffs) :-
|
||||
check_for_hidden_vars(Vs0, Vs0, Vs1),
|
||||
sort(Vs1,Vs),
|
||||
% LVi will have a list of CLPBN variables
|
||||
% Tables0 will have the full data on each variable
|
||||
find_all_clpbn_vars(Vs, LV0, LVi, Tables0),
|
||||
% construct the graph
|
||||
find_all_table_deps(Tables0, LV0),
|
||||
(clpbn:output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,vel,Vs) ; true),
|
||||
(clpbn:output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,vel,Vs,LVs) ; true),
|
||||
% variable elimination proper
|
||||
process(LVi, LVs, tab(Dist,_,_)),
|
||||
% move from potentials back to probabilities
|
||||
normalise_CPT(Dist,Ps),
|
||||
% from array to list
|
||||
list_from_CPT(Ps, LPs),
|
||||
% bind Probs back to variables so that they can be output.
|
||||
clpbn_bind_vals(LVs,LPs,AllDiffs).
|
||||
|
||||
%
|
||||
% just get a list of variables plus associated tables
|
||||
%
|
||||
find_all_clpbn_vars([], [], [], []) :- !.
|
||||
find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Parents,Sizes)|Tables]) :-
|
||||
var_with_deps(V, Table, Parents, Sizes, Ev, Vals), !,
|
||||
@ -82,7 +95,9 @@ var_with_deps(V, Table, Deps, Sizes, Ev, Vals) :-
|
||||
clpbn:get_atts(V, [dist(Id,Parents)]),
|
||||
get_dist_matrix(Id,Parents,_,Vals,TAB0),
|
||||
( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true),
|
||||
% set CPT in canonical form
|
||||
reorder_CPT([V|Parents],TAB0,Deps0,TAB1,Sizes1),
|
||||
% remove evidence.
|
||||
simplify_evidence(Deps0, TAB1, Deps0, Sizes1, Table, Deps, Sizes).
|
||||
|
||||
find_all_table_deps(Tables0, LV) :-
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: aggregate.pl,v 1.2 2008-02-12 18:10:48 vsc Exp $
|
||||
/* $Id: aggregate.pl,v 1.3 2008-03-13 14:37:58 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
@ -524,7 +524,7 @@ var_in_term(Term, Var) :-
|
||||
Var == Term, !.
|
||||
var_in_term(Term, Var) :-
|
||||
compound(Term),
|
||||
arg(_, Term, Arg),
|
||||
genarg(_, Term, Arg),
|
||||
var_in_term(Arg, Var), !.
|
||||
|
||||
|
||||
|
||||
@ -669,6 +669,7 @@ typedef enum
|
||||
SequentialPredFlag = 0x00000020L, /* may not create parallel choice points! */
|
||||
ProfiledPredFlag = 0x00000010L, /* pred is being profiled */
|
||||
MyddasPredFlag = 0x00000008L, /* Myddas Imported pred */
|
||||
ModuleTransparentPredFlag = 0x00000004L, /* ModuleTransparent pred */
|
||||
} pred_flag;
|
||||
|
||||
/* profile data */
|
||||
|
||||
@ -31,10 +31,13 @@ PROGRAMS= $(srcdir)/debug.pl \
|
||||
$(srcdir)/prolog_source.pl \
|
||||
$(srcdir)/prolog_xref.pl
|
||||
|
||||
SWI_PROGRAMS= $(srcdir)/apply_macros.pl
|
||||
|
||||
|
||||
install: $(PROGRAMS)
|
||||
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
|
||||
for p in $(PROGRAMS); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/Yap; done
|
||||
for p in $(SWI_PROGRAMS); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/Yap/swi; done
|
||||
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/logtalk
|
||||
for p in $(LOGTALK_PROGRAMS); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/Yap/logtalk; done
|
||||
|
||||
|
||||
185
LGPL/apply_macros.pl
Normal file
185
LGPL/apply_macros.pl
Normal file
@ -0,0 +1,185 @@
|
||||
/* $Id: apply_macros.pl,v 1.1 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: wielemak@science.uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2007, University of Amsterdam
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
As a special exception, if you link this library with other files,
|
||||
compiled with a Free Software compiler, to produce an executable, this
|
||||
library does not by itself cause the resulting executable to be covered
|
||||
by the GNU General Public License. This exception does not however
|
||||
invalidate any other reasons why the executable file might be covered by
|
||||
the GNU General Public License.
|
||||
*/
|
||||
|
||||
:- module(apply_macros,
|
||||
[
|
||||
]).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(occurs)).
|
||||
|
||||
/** <module> Goal expansion rules to avoid meta-calling
|
||||
|
||||
This module defines goal_expansion/2 rules to deal with commonly used,
|
||||
but fundamentally slow meta-predicates. Notable maplist/2... defines a
|
||||
useful set of predicates, but its exection is considerable slower than a
|
||||
traditional Prolog loop. Using this library calls to maplist/2... are
|
||||
translated into an call to a generated auxilary predicate that is
|
||||
compiled using compile_aux_clauses/1. Currently this module supports:
|
||||
|
||||
* maplist/2..
|
||||
* forall/2
|
||||
* once/1
|
||||
* ignore/1
|
||||
* phrase/2
|
||||
* phrase/3
|
||||
|
||||
@tbd Support more predicates
|
||||
@author Jan Wielemaker
|
||||
*/
|
||||
|
||||
:- dynamic
|
||||
user:goal_expansion/2.
|
||||
:- multifile
|
||||
user:goal_expansion/2.
|
||||
|
||||
|
||||
%% expand_maplist(+Callable, +Lists, -Goal) is det.
|
||||
%
|
||||
% Macro expansion for maplist/2 and higher arity.
|
||||
|
||||
expand_maplist(Callable0, Lists, Goal) :-
|
||||
( Callable0 = _:_
|
||||
-> strip_module(Callable0, M, Callable),
|
||||
NextGoal = M:NextCall
|
||||
; Callable = Callable0,
|
||||
NextGoal = NextCall
|
||||
),
|
||||
Callable =.. [Pred|Args],
|
||||
length(Args, Argc),
|
||||
length(Argv, Argc),
|
||||
length(Lists, N),
|
||||
length(Vars, N),
|
||||
MapArity is N + 1,
|
||||
format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, Pred, Argc]),
|
||||
append(Lists, Args, AuxArgs),
|
||||
Goal =.. [AuxName|AuxArgs],
|
||||
|
||||
AuxArity is N+Argc,
|
||||
prolog_load_context(module, Module),
|
||||
( current_predicate(Module:AuxName/AuxArity)
|
||||
-> true
|
||||
; empty_lists(N, BaseLists),
|
||||
length(Anon, Argc),
|
||||
append(BaseLists, Anon, BaseArgs),
|
||||
BaseClause =.. [AuxName|BaseArgs],
|
||||
|
||||
heads_and_tails(N, NextArgs, Vars, Tails),
|
||||
append(NextArgs, Argv, AllNextArgs),
|
||||
NextHead =.. [AuxName|AllNextArgs],
|
||||
append(Argv, Vars, PredArgs),
|
||||
NextCall =.. [Pred|PredArgs],
|
||||
append(Tails, Argv, IttArgs),
|
||||
NextIterate =.. [AuxName|IttArgs],
|
||||
NextClause = (NextHead :- NextGoal, NextIterate),
|
||||
|
||||
( predicate_property(NextGoal, transparent)
|
||||
-> compile_aux_clauses([ (:- module_transparent(Module:AuxName/AuxArity)),
|
||||
BaseClause,
|
||||
NextClause
|
||||
])
|
||||
; compile_aux_clauses([BaseClause, NextClause])
|
||||
)
|
||||
).
|
||||
|
||||
|
||||
empty_lists(0, []) :- !.
|
||||
empty_lists(N, [[]|T]) :-
|
||||
N2 is N - 1,
|
||||
empty_lists(N2, T).
|
||||
|
||||
heads_and_tails(0, [], [], []).
|
||||
heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :-
|
||||
N2 is N - 1,
|
||||
heads_and_tails(N2, L1, L2, L3).
|
||||
|
||||
|
||||
%% expand_apply(+GoalIn:callable, -GoalOut) is semidet.
|
||||
%
|
||||
% Macro expansion for `apply' predicates.
|
||||
|
||||
expand_apply(Maplist, Goal) :-
|
||||
functor(Maplist, maplist, N),
|
||||
N >= 2,
|
||||
Maplist =.. [maplist, Callable|Lists],
|
||||
callable(Callable), !,
|
||||
expand_maplist(Callable, Lists, Goal).
|
||||
expand_apply(forall(Cond, Action), \+((Cond, \+(Action)))).
|
||||
expand_apply(once(Goal), (Goal->true)).
|
||||
expand_apply(ignore(Goal), (Goal->true;true)).
|
||||
expand_apply(phrase(NT,Xs), NTXsNil) :-
|
||||
expand_apply(phrase(NT,Xs,[]), NTXsNil).
|
||||
expand_apply(phrase(NT,Xs0,Xs), NewGoal) :-
|
||||
Goal = phrase(NT,Xs0,Xs),
|
||||
nonvar(NT),
|
||||
catch('$translate_rule'((pseudo_nt --> NT), Rule),
|
||||
error(Pat,ImplDep),
|
||||
( \+ harmless_dcgexception(Pat),
|
||||
throw(error(Pat,ImplDep))
|
||||
)),
|
||||
Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
|
||||
Goal \== NewGoal0,
|
||||
\+ contains_illegal_dcgnt(NT), !, % apply translation only if we are safe
|
||||
( var(Xsc), Xsc \== Xs0c
|
||||
-> Xs = Xsc, NewGoal1 = NewGoal0
|
||||
; NewGoal1 = (NewGoal0, Xsc = Xs)
|
||||
),
|
||||
( var(Xs0c)
|
||||
-> Xs0 = Xs0c,
|
||||
NewGoal = NewGoal1
|
||||
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
|
||||
).
|
||||
|
||||
harmless_dcgexception(instantiation_error). % ex: phrase(([1],x:X,[3]),L)
|
||||
harmless_dcgexception(type_error(callable,_)). % ex: phrase(27,L)
|
||||
|
||||
|
||||
%% contains_illegal_dcgnt(+Term) is semidet.
|
||||
%
|
||||
% True if Term contains a non-terminal we cannot deal with using
|
||||
% goal-expansion. The test is too general approximation, but safe.
|
||||
|
||||
contains_illegal_dcgnt(NT) :-
|
||||
sub_term(I, NT),
|
||||
nonvar(I),
|
||||
( I = ! ; I = phrase(_,_,_) ), !.
|
||||
% write(contains_illegal_nt(NT)), % JW: we do not want to write
|
||||
% nl.
|
||||
|
||||
/*******************************
|
||||
* ACTIVATE *
|
||||
*******************************/
|
||||
|
||||
% @tbd Should we only apply if optimization is enabled (-O)?
|
||||
|
||||
user:goal_expansion(GoalIn, GoalOut) :-
|
||||
\+ current_prolog_flag(xref, true),
|
||||
expand_apply(GoalIn, GoalOut).
|
||||
|
||||
@ -93,16 +93,453 @@ builtin_binds_(atomic(_),L,L).
|
||||
builtin_binds_(integer(_),L,L).
|
||||
builtin_binds_(float(_),L,L).
|
||||
|
||||
builtin_binds_(_ > _ ,L,L).
|
||||
builtin_binds_(_ < _ ,L,L).
|
||||
builtin_binds_(_ =< _,L,L).
|
||||
builtin_binds_(_ >= _,L,L).
|
||||
builtin_binds_(_ =:= _,L,L).
|
||||
builtin_binds_(_ =\= _,L,L).
|
||||
builtin_binds_(_ == _,L,L).
|
||||
builtin_binds_(_ \== _,L,L).
|
||||
builtin_binds_(?=(_, _), L, L).
|
||||
builtin_binds_(_<_, L, L).
|
||||
builtin_binds_(_=:=_, L, L).
|
||||
builtin_binds_(_=<_, L, L).
|
||||
builtin_binds_(_==_, L, L).
|
||||
builtin_binds_(_=@=_, L, L).
|
||||
builtin_binds_(_=\=_, L, L).
|
||||
builtin_binds_(_>=_, L, L).
|
||||
builtin_binds_(_>_, L, L).
|
||||
builtin_binds_(_@<_, L, L).
|
||||
builtin_binds_(_@=<_, L, L).
|
||||
builtin_binds_(_@>=_, L, L).
|
||||
builtin_binds_(_@>_, L, L).
|
||||
builtin_binds_(_\==_, L, L).
|
||||
builtin_binds_(_\=@=_, L, L).
|
||||
builtin_binds_(true,L,L).
|
||||
|
||||
% TODO: check all these SWI-Prolog built-ins for binding behavior.
|
||||
%
|
||||
% builtin_binds_(format(_,_),L,L).
|
||||
% builtin_binds_(portray(_), L, L).
|
||||
% builtin_binds_(write(_), L, L).
|
||||
% builtin_binds_(write(_),L,L).
|
||||
% builtin_binds_(write(_, _), L, L).
|
||||
% builtin_binds_(write_canonical(_), L, L).
|
||||
% builtin_binds_(write_canonical(_, _), L, L).
|
||||
% builtin_binds_(write_term(_, _), L, L).
|
||||
% builtin_binds_(write_term(_, _, _), L, L).
|
||||
% builtin_binds_(writef(_), L, L).
|
||||
% builtin_binds_(writef(_, _), L, L).
|
||||
% builtin_binds_(writeln(_), L, L).
|
||||
% builtin_binds_(writeln(_),L,L).
|
||||
% builtin_binds_(writeq(_), L, L).
|
||||
% builtin_binds_(writeq(_, _), L, L).
|
||||
%
|
||||
% builtin_binds_(!(_), L, L).
|
||||
% builtin_binds_(!, L, L).
|
||||
% builtin_binds_((_'|'_), L, L).
|
||||
% builtin_binds_((_*->_), L, L).
|
||||
% builtin_binds_(abolish(_), L, L).
|
||||
% builtin_binds_(abolish(_, _), L, L).
|
||||
% builtin_binds_(abort, L, L).
|
||||
% builtin_binds_(absolute_file_name(_, _), L, L).
|
||||
% builtin_binds_(absolute_file_name(_, _, _), L, L).
|
||||
% builtin_binds_(access_file(_, _), L, L).
|
||||
% builtin_binds_(acyclic_term(_), L, L).
|
||||
% builtin_binds_(add_import_module(_, _, _), L, L).
|
||||
% builtin_binds_(append(_), L, L).
|
||||
% builtin_binds_(apply(_, _), L, L).
|
||||
% builtin_binds_(arg(_, _, _), L, L).
|
||||
% builtin_binds_(arithmetic_function(_), L, L).
|
||||
% builtin_binds_(assert(_), L, L).
|
||||
% builtin_binds_(assert(_, _), L, L).
|
||||
% builtin_binds_(asserta(_), L, L).
|
||||
% builtin_binds_(asserta(_, _), L, L).
|
||||
% builtin_binds_(assertz(_), L, L).
|
||||
% builtin_binds_(assertz(_, _), L, L).
|
||||
% builtin_binds_(at_end_of_stream(_), L, L).
|
||||
% builtin_binds_(at_end_of_stream, L, L).
|
||||
% builtin_binds_(at_halt(_), L, L).
|
||||
% builtin_binds_(at_initialization(_), L, L).
|
||||
% builtin_binds_(atom(_), L, L).
|
||||
% builtin_binds_(atom_chars(_, _), L, L).
|
||||
% builtin_binds_(atom_codes(_, _), L, L).
|
||||
% builtin_binds_(atom_concat(_, _, _), L, L).
|
||||
% builtin_binds_(atom_length(_, _), L, L).
|
||||
% builtin_binds_(atom_number(_, _), L, L).
|
||||
% builtin_binds_(atom_prefix(_, _), L, L).
|
||||
% builtin_binds_(atom_to_term(_, _, _), L, L).
|
||||
% builtin_binds_(atomic(_), L, L).
|
||||
% builtin_binds_(attvar(_), L, L).
|
||||
% builtin_binds_(autoload(_), L, L).
|
||||
% builtin_binds_(autoload, L, L).
|
||||
% builtin_binds_(b_getval(_, _), L, L).
|
||||
% builtin_binds_(b_setval(_, _), L, L).
|
||||
% builtin_binds_(bagof(_, _, _), L, L).
|
||||
% builtin_binds_(between(_, _, _), L, L).
|
||||
% builtin_binds_(block(_, _, _), L, L).
|
||||
% builtin_binds_(break, L, L).
|
||||
% builtin_binds_(byte_count(_, _), L, L).
|
||||
% builtin_binds_(call(_), L, L).
|
||||
% builtin_binds_(call(_, _), L, L).
|
||||
% builtin_binds_(call(_, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _, _, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _, _, _, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _, _, _, _, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _, _, _, _, _, _, _), L, L).
|
||||
% builtin_binds_(call(_, _, _, _, _, _, _, _, _, _, _), L, L).
|
||||
% builtin_binds_(call_cleanup(_, _), L, L).
|
||||
% builtin_binds_(call_cleanup(_, _, _), L, L).
|
||||
% builtin_binds_(call_shared_object_function(_, _), L, L).
|
||||
% builtin_binds_(call_with_depth_limit(_, _, _), L, L).
|
||||
% builtin_binds_(callable(_), L, L).
|
||||
% builtin_binds_(catch(_, _, _), L, L).
|
||||
% builtin_binds_(char_code(_, _), L, L).
|
||||
% builtin_binds_(char_conversion(_, _), L, L).
|
||||
% builtin_binds_(char_type(_, _), L, L).
|
||||
% builtin_binds_(character_count(_, _), L, L).
|
||||
% builtin_binds_(clause(_, _), L, L).
|
||||
% builtin_binds_(clause(_, _, _), L, L).
|
||||
% builtin_binds_(clause_property(_, _), L, L).
|
||||
% builtin_binds_(close(_), L, L).
|
||||
% builtin_binds_(close(_, _), L, L).
|
||||
% builtin_binds_(close_shared_object(_), L, L).
|
||||
% builtin_binds_(code_type(_, _), L, L).
|
||||
% builtin_binds_(collation_key(_, _), L, L).
|
||||
% builtin_binds_(compare(_, _, _), L, L).
|
||||
% builtin_binds_(compile_aux_clauses(_), L, L).
|
||||
% builtin_binds_(compile_predicates(_), L, L).
|
||||
% builtin_binds_(compiling, L, L).
|
||||
% builtin_binds_(compound(_), L, L).
|
||||
% builtin_binds_(concat_atom(_, _), L, L).
|
||||
% builtin_binds_(concat_atom(_, _, _), L, L).
|
||||
% builtin_binds_(consult(_), L, L).
|
||||
% builtin_binds_(context_module(_), L, L).
|
||||
% builtin_binds_(copy_stream_data(_, _), L, L).
|
||||
% builtin_binds_(copy_stream_data(_, _, _), L, L).
|
||||
% builtin_binds_(copy_term(_, _), L, L).
|
||||
% builtin_binds_(copy_term_nat(_, _), L, L).
|
||||
% builtin_binds_(current_arithmetic_function(_), L, L).
|
||||
% builtin_binds_(current_atom(_), L, L).
|
||||
% builtin_binds_(current_blob(_, _), L, L).
|
||||
% builtin_binds_(current_char_conversion(_, _), L, L).
|
||||
% builtin_binds_(current_flag(_), L, L).
|
||||
% builtin_binds_(current_format_predicate(_, _), L, L).
|
||||
% builtin_binds_(current_functor(_, _), L, L).
|
||||
% builtin_binds_(current_input(_), L, L).
|
||||
% builtin_binds_(current_key(_), L, L).
|
||||
% builtin_binds_(current_module(_), L, L).
|
||||
% builtin_binds_(current_module(_, _), L, L).
|
||||
% builtin_binds_(current_op(_, _, _), L, L).
|
||||
% builtin_binds_(current_output(_), L, L).
|
||||
% builtin_binds_(current_predicate(_), L, L).
|
||||
% builtin_binds_(current_predicate(_, _), L, L).
|
||||
% builtin_binds_(current_prolog_flag(_, _), L, L).
|
||||
% builtin_binds_(current_resource(_, _, _), L, L).
|
||||
% builtin_binds_(current_signal(_, _, _), L, L).
|
||||
% builtin_binds_(cyclic_term(_), L, L).
|
||||
% builtin_binds_(date_time_stamp(_, _), L, L).
|
||||
% builtin_binds_(debugging, L, L).
|
||||
% builtin_binds_(default_module(_, _), L, L).
|
||||
% builtin_binds_(del_attr(_, _), L, L).
|
||||
% builtin_binds_(delete_directory(_), L, L).
|
||||
% builtin_binds_(delete_file(_), L, L).
|
||||
% builtin_binds_(delete_import_module(_, _), L, L).
|
||||
% builtin_binds_(deterministic(_), L, L).
|
||||
% builtin_binds_(downcase_atom(_, _), L, L).
|
||||
% builtin_binds_(duplicate_term(_, _), L, L).
|
||||
% builtin_binds_(dwim_match(_, _), L, L).
|
||||
% builtin_binds_(dwim_match(_, _, _), L, L).
|
||||
% builtin_binds_(dwim_predicate(_, _), L, L).
|
||||
% builtin_binds_(ensure_loaded(_), L, L).
|
||||
% builtin_binds_(erase(_), L, L).
|
||||
% builtin_binds_(eval_license, L, L).
|
||||
% builtin_binds_(exists_directory(_), L, L).
|
||||
% builtin_binds_(exists_file(_), L, L).
|
||||
% builtin_binds_(exit(_, _), L, L).
|
||||
% builtin_binds_(expand_file_name(_, _), L, L).
|
||||
% builtin_binds_(expand_file_search_path(_, _), L, L).
|
||||
% builtin_binds_(expand_goal(_, _), L, L).
|
||||
% builtin_binds_(expand_term(_, _), L, L).
|
||||
% builtin_binds_(export(_), L, L).
|
||||
% builtin_binds_(export_list(_, _), L, L).
|
||||
% builtin_binds_(fail(_), L, L).
|
||||
% builtin_binds_(fail, L, L).
|
||||
% builtin_binds_(file_base_name(_, _), L, L).
|
||||
% builtin_binds_(file_directory_name(_, _), L, L).
|
||||
% builtin_binds_(file_name_extension(_, _, _), L, L).
|
||||
% builtin_binds_(fileerrors(_, _), L, L).
|
||||
% builtin_binds_(findall(_, _, _), L, L).
|
||||
% builtin_binds_(findall(_, _, _, _), L, L).
|
||||
% builtin_binds_(flag(_, _, _), L, L).
|
||||
% builtin_binds_(float(_), L, L).
|
||||
% builtin_binds_(flush_output(_), L, L).
|
||||
% builtin_binds_(flush_output, L, L).
|
||||
% builtin_binds_(forall(_, _), L, L).
|
||||
% builtin_binds_(format(_), L, L).
|
||||
% builtin_binds_(format(_, _), L, L).
|
||||
% builtin_binds_(format(_, _, _), L, L).
|
||||
% builtin_binds_(format_predicate(_, _), L, L).
|
||||
% builtin_binds_(format_time(_, _, _), L, L).
|
||||
% builtin_binds_(format_time(_, _, _, _), L, L).
|
||||
% builtin_binds_(freeze(_, _), L, L).
|
||||
% builtin_binds_(frozen(_, _), L, L).
|
||||
% builtin_binds_(functor(_, _, _), L, L).
|
||||
% builtin_binds_(garbage_collect, L, L).
|
||||
% builtin_binds_(garbage_collect_atoms, L, L).
|
||||
% builtin_binds_(garbage_collect_clauses, L, L).
|
||||
% builtin_binds_(get(_), L, L).
|
||||
% builtin_binds_(get(_, _), L, L).
|
||||
% builtin_binds_(get0(_), L, L).
|
||||
% builtin_binds_(get0(_, _), L, L).
|
||||
% builtin_binds_(get_attr(_, _, _), L, L).
|
||||
% builtin_binds_(get_attrs(_, _), L, L).
|
||||
% builtin_binds_(get_byte(_), L, L).
|
||||
% builtin_binds_(get_byte(_, _), L, L).
|
||||
% builtin_binds_(get_char(_), L, L).
|
||||
% builtin_binds_(get_char(_, _), L, L).
|
||||
% builtin_binds_(get_code(_), L, L).
|
||||
% builtin_binds_(get_code(_, _), L, L).
|
||||
% builtin_binds_(get_single_char(_), L, L).
|
||||
% builtin_binds_(get_time(_), L, L).
|
||||
% builtin_binds_(getenv(_, _), L, L).
|
||||
% builtin_binds_(ground(_), L, L).
|
||||
% builtin_binds_(halt(_), L, L).
|
||||
% builtin_binds_(halt, L, L).
|
||||
% builtin_binds_(hash(_), L, L).
|
||||
% builtin_binds_(hash_term(_, _), L, L).
|
||||
% builtin_binds_(ignore(_), L, L).
|
||||
% builtin_binds_(import(_), L, L).
|
||||
% builtin_binds_(import_module(_, _), L, L).
|
||||
% builtin_binds_(index(_), L, L).
|
||||
% builtin_binds_(integer(_), L, L).
|
||||
% builtin_binds_(is_absolute_file_name(_), L, L).
|
||||
% builtin_binds_(is_list(_), L, L).
|
||||
% builtin_binds_(is_stream(_), L, L).
|
||||
% builtin_binds_(keysort(_, _), L, L).
|
||||
% builtin_binds_(leash(_), L, L).
|
||||
% builtin_binds_(length(_, _), L, L).
|
||||
% builtin_binds_(license(_), L, L).
|
||||
% builtin_binds_(license(_, _), L, L).
|
||||
% builtin_binds_(line_count(_, _), L, L).
|
||||
% builtin_binds_(line_position(_, _), L, L).
|
||||
% builtin_binds_(load_files(_), L, L).
|
||||
% builtin_binds_(load_files(_, _), L, L).
|
||||
% builtin_binds_(make_directory(_), L, L).
|
||||
% builtin_binds_(make_library_index(_), L, L).
|
||||
% builtin_binds_(make_library_index(_, _), L, L).
|
||||
% builtin_binds_(maplist(_, _), L, L).
|
||||
% builtin_binds_(maplist(_, _, _), L, L).
|
||||
% builtin_binds_(maplist(_, _, _, _), L, L).
|
||||
% builtin_binds_(memberchk(_, _), L, L).
|
||||
% builtin_binds_(message_queue_create(_), L, L).
|
||||
% builtin_binds_(message_queue_create(_, _), L, L).
|
||||
% builtin_binds_(message_queue_destroy(_), L, L).
|
||||
% builtin_binds_(message_queue_property(_, _), L, L).
|
||||
% builtin_binds_(message_to_string(_, _), L, L).
|
||||
% builtin_binds_(module(_), L, L).
|
||||
% builtin_binds_(msort(_, _), L, L).
|
||||
% builtin_binds_(mutex_create(_), L, L).
|
||||
% builtin_binds_(mutex_create(_, _), L, L).
|
||||
% builtin_binds_(mutex_destroy(_), L, L).
|
||||
% builtin_binds_(mutex_lock(_), L, L).
|
||||
% builtin_binds_(mutex_property(_, _), L, L).
|
||||
% builtin_binds_(mutex_statistics, L, L).
|
||||
% builtin_binds_(mutex_trylock(_), L, L).
|
||||
% builtin_binds_(mutex_unlock(_), L, L).
|
||||
% builtin_binds_(mutex_unlock_all, L, L).
|
||||
% builtin_binds_(name(_, _), L, L).
|
||||
% builtin_binds_(nb_current(_, _), L, L).
|
||||
% builtin_binds_(nb_delete(_), L, L).
|
||||
% builtin_binds_(nb_getval(_, _), L, L).
|
||||
% builtin_binds_(nb_linkarg(_, _, _), L, L).
|
||||
% builtin_binds_(nb_linkval(_, _), L, L).
|
||||
% builtin_binds_(nb_setarg(_, _, _), L, L).
|
||||
% builtin_binds_(nb_setval(_, _), L, L).
|
||||
% builtin_binds_(nl(_), L, L).
|
||||
% builtin_binds_(nl, L, L).
|
||||
% builtin_binds_(nonvar(_), L, L).
|
||||
% builtin_binds_(noprofile(_), L, L).
|
||||
% builtin_binds_(noprotocol, L, L).
|
||||
% builtin_binds_(nospy(_), L, L).
|
||||
% builtin_binds_(nospyall, L, L).
|
||||
% builtin_binds_(not(_), L, L).
|
||||
% builtin_binds_(notrace(_), L, L).
|
||||
% builtin_binds_(notrace, L, L).
|
||||
% builtin_binds_(nth_clause(_, _, _), L, L).
|
||||
% builtin_binds_(number(_), L, L).
|
||||
% builtin_binds_(number_chars(_, _), L, L).
|
||||
% builtin_binds_(number_codes(_, _), L, L).
|
||||
% builtin_binds_(numbervars(_, _, _), L, L).
|
||||
% builtin_binds_(numbervars(_, _, _, _), L, L).
|
||||
% builtin_binds_(on_signal(_, _, _), L, L).
|
||||
% builtin_binds_(once(_), L, L).
|
||||
% builtin_binds_(op(_, _, _), L, L).
|
||||
% builtin_binds_(open(_, _, _), L, L).
|
||||
% builtin_binds_(open(_, _, _, _), L, L).
|
||||
% builtin_binds_(open_null_stream(_), L, L).
|
||||
% builtin_binds_(open_resource(_, _, _), L, L).
|
||||
% builtin_binds_(open_resource(_, _, _, _), L, L).
|
||||
% builtin_binds_(open_shared_object(_, _), L, L).
|
||||
% builtin_binds_(open_shared_object(_, _, _), L, L).
|
||||
% builtin_binds_(open_xterm(_, _, _, _), L, L).
|
||||
% builtin_binds_(peek_byte(_), L, L).
|
||||
% builtin_binds_(peek_byte(_, _), L, L).
|
||||
% builtin_binds_(peek_char(_), L, L).
|
||||
% builtin_binds_(peek_char(_, _), L, L).
|
||||
% builtin_binds_(peek_code(_), L, L).
|
||||
% builtin_binds_(peek_code(_, _), L, L).
|
||||
% builtin_binds_(phrase(_, _), L, L).
|
||||
% builtin_binds_(phrase(_, _, _), L, L).
|
||||
% builtin_binds_(plus(_, _, _), L, L).
|
||||
% builtin_binds_(predicate_property(_, _), L, L).
|
||||
% builtin_binds_(preprocessor(_, _), L, L).
|
||||
% builtin_binds_(print(_), L, L).
|
||||
% builtin_binds_(print(_, _), L, L).
|
||||
% builtin_binds_(print_message(_, _), L, L).
|
||||
% builtin_binds_(print_message_lines(_, _, _), L, L).
|
||||
% builtin_binds_(profiler(_, _), L, L).
|
||||
% builtin_binds_(prolog, L, L).
|
||||
% builtin_binds_(prolog_choice_attribute(_, _, _), L, L).
|
||||
% builtin_binds_(prolog_current_frame(_), L, L).
|
||||
% builtin_binds_(prolog_frame_attribute(_, _, _), L, L).
|
||||
% builtin_binds_(prolog_load_context(_, _), L, L).
|
||||
% builtin_binds_(prolog_skip_level(_, _), L, L).
|
||||
% builtin_binds_(prolog_to_os_filename(_, _), L, L).
|
||||
% builtin_binds_(prompt(_, _), L, L).
|
||||
% builtin_binds_(prompt1(_), L, L).
|
||||
% builtin_binds_(protocol(_), L, L).
|
||||
% builtin_binds_(protocola(_), L, L).
|
||||
% builtin_binds_(protocolling(_), L, L).
|
||||
% builtin_binds_(put(_), L, L).
|
||||
% builtin_binds_(put(_, _), L, L).
|
||||
% builtin_binds_(put_attr(_, _, _), L, L).
|
||||
% builtin_binds_(put_attrs(_, _), L, L).
|
||||
% builtin_binds_(put_byte(_), L, L).
|
||||
% builtin_binds_(put_byte(_, _), L, L).
|
||||
% builtin_binds_(put_char(_), L, L).
|
||||
% builtin_binds_(put_char(_, _), L, L).
|
||||
% builtin_binds_(put_code(_), L, L).
|
||||
% builtin_binds_(put_code(_, _), L, L).
|
||||
% builtin_binds_(qcompile(_), L, L).
|
||||
% builtin_binds_(rational(_), L, L).
|
||||
% builtin_binds_(rational(_, _, _), L, L).
|
||||
% builtin_binds_(read(_), L, L).
|
||||
% builtin_binds_(read(_, _), L, L).
|
||||
% builtin_binds_(read_clause(_), L, L).
|
||||
% builtin_binds_(read_clause(_, _), L, L).
|
||||
% builtin_binds_(read_history(_, _, _, _, _, _), L, L).
|
||||
% builtin_binds_(read_link(_, _, _), L, L).
|
||||
% builtin_binds_(read_pending_input(_, _, _), L, L).
|
||||
% builtin_binds_(read_term(_, _), L, L).
|
||||
% builtin_binds_(read_term(_, _, _), L, L).
|
||||
% builtin_binds_(recorda(_, _), L, L).
|
||||
% builtin_binds_(recorda(_, _, _), L, L).
|
||||
% builtin_binds_(recorded(_, _), L, L).
|
||||
% builtin_binds_(recorded(_, _, _), L, L).
|
||||
% builtin_binds_(recordz(_, _), L, L).
|
||||
% builtin_binds_(recordz(_, _, _), L, L).
|
||||
% builtin_binds_(redefine_system_predicate(_), L, L).
|
||||
% builtin_binds_(reload_library_index, L, L).
|
||||
% builtin_binds_(rename_file(_, _), L, L).
|
||||
% builtin_binds_(repeat, L, L).
|
||||
% builtin_binds_(require(_), L, L).
|
||||
% builtin_binds_(reset_profiler, L, L).
|
||||
% builtin_binds_(retract(_), L, L).
|
||||
% builtin_binds_(retractall(_), L, L).
|
||||
% builtin_binds_(same_file(_, _), L, L).
|
||||
% builtin_binds_(same_term(_, _), L, L).
|
||||
% builtin_binds_(see(_), L, L).
|
||||
% builtin_binds_(seeing(_), L, L).
|
||||
% builtin_binds_(seek(_, _, _, _), L, L).
|
||||
% builtin_binds_(seen, L, L).
|
||||
% builtin_binds_(set_input(_), L, L).
|
||||
% builtin_binds_(set_output(_), L, L).
|
||||
% builtin_binds_(set_prolog_IO(_, _, _), L, L).
|
||||
% builtin_binds_(set_prolog_flag(_, _), L, L).
|
||||
% builtin_binds_(set_stream(_, _), L, L).
|
||||
% builtin_binds_(set_stream_position(_, _), L, L).
|
||||
% builtin_binds_(setarg(_, _, _), L, L).
|
||||
% builtin_binds_(setenv(_, _), L, L).
|
||||
% builtin_binds_(setlocale(_, _, _), L, L).
|
||||
% builtin_binds_(setof(_, _, _), L, L).
|
||||
% builtin_binds_(setup_and_call_cleanup(_, _, _), L, L).
|
||||
% builtin_binds_(setup_and_call_cleanup(_, _, _, _), L, L).
|
||||
% builtin_binds_(shell(_), L, L).
|
||||
% builtin_binds_(shell(_, _), L, L).
|
||||
% builtin_binds_(shell, L, L).
|
||||
% builtin_binds_(size_file(_, _), L, L).
|
||||
% builtin_binds_(skip(_), L, L).
|
||||
% builtin_binds_(skip(_, _), L, L).
|
||||
% builtin_binds_(sleep(_), L, L).
|
||||
% builtin_binds_(sort(_, _), L, L).
|
||||
% builtin_binds_(source_file(_), L, L).
|
||||
% builtin_binds_(source_file(_, _), L, L).
|
||||
% builtin_binds_(source_location(_, _), L, L).
|
||||
% builtin_binds_(spy(_), L, L).
|
||||
% builtin_binds_(stamp_date_time(_, _, _), L, L).
|
||||
% builtin_binds_(statistics(_, _), L, L).
|
||||
% builtin_binds_(statistics, L, L).
|
||||
% builtin_binds_(stream_position_data(_, _, _), L, L).
|
||||
% builtin_binds_(stream_property(_, _), L, L).
|
||||
% builtin_binds_(string(_), L, L).
|
||||
% builtin_binds_(string_concat(_, _, _), L, L).
|
||||
% builtin_binds_(string_length(_, _), L, L).
|
||||
% builtin_binds_(string_to_atom(_, _), L, L).
|
||||
% builtin_binds_(string_to_list(_, _), L, L).
|
||||
% builtin_binds_(strip_module(_, _, _), L, L).
|
||||
% builtin_binds_(style_check(_), L, L).
|
||||
% builtin_binds_(sub_atom(_, _, _, _, _), L, L).
|
||||
% builtin_binds_(sub_string(_, _, _, _, _), L, L).
|
||||
% builtin_binds_(succ(_, _), L, L).
|
||||
% builtin_binds_(swritef(_, _), L, L).
|
||||
% builtin_binds_(swritef(_, _, _), L, L).
|
||||
% builtin_binds_(tab(_), L, L).
|
||||
% builtin_binds_(tab(_, _), L, L).
|
||||
% builtin_binds_(tell(_), L, L).
|
||||
% builtin_binds_(telling(_), L, L).
|
||||
% builtin_binds_(term_to_atom(_, _), L, L).
|
||||
% builtin_binds_(term_variables(_, _), L, L).
|
||||
% builtin_binds_(term_variables(_, _, _), L, L).
|
||||
% builtin_binds_(thread_at_exit(_), L, L).
|
||||
% builtin_binds_(thread_create(_, _, _), L, L).
|
||||
% builtin_binds_(thread_detach(_), L, L).
|
||||
% builtin_binds_(thread_exit(_), L, L).
|
||||
% builtin_binds_(thread_get_message(_), L, L).
|
||||
% builtin_binds_(thread_get_message(_, _), L, L).
|
||||
% builtin_binds_(thread_join(_, _), L, L).
|
||||
% builtin_binds_(thread_kill(_, _), L, L).
|
||||
% builtin_binds_(thread_peek_message(_), L, L).
|
||||
% builtin_binds_(thread_peek_message(_, _), L, L).
|
||||
% builtin_binds_(thread_property(_, _), L, L).
|
||||
% builtin_binds_(thread_self(_), L, L).
|
||||
% builtin_binds_(thread_send_message(_, _), L, L).
|
||||
% builtin_binds_(thread_setconcurrency(_, _), L, L).
|
||||
% builtin_binds_(thread_signal(_, _), L, L).
|
||||
% builtin_binds_(thread_statistics(_, _, _), L, L).
|
||||
% builtin_binds_(throw(_), L, L).
|
||||
% builtin_binds_(time_file(_, _), L, L).
|
||||
% builtin_binds_(tmp_file(_, _), L, L).
|
||||
% builtin_binds_(told, L, L).
|
||||
% builtin_binds_(trim_stacks, L, L).
|
||||
% builtin_binds_(tty_get_capability(_, _, _), L, L).
|
||||
% builtin_binds_(tty_goto(_, _), L, L).
|
||||
% builtin_binds_(tty_put(_, _), L, L).
|
||||
% builtin_binds_(tty_size(_, _), L, L).
|
||||
% builtin_binds_(ttyflush, L, L).
|
||||
% builtin_binds_(unifiable(_, _, _), L, L).
|
||||
% builtin_binds_(unify_with_occurs_check(_, _), L, L).
|
||||
% builtin_binds_(unsetenv(_), L, L).
|
||||
% builtin_binds_(upcase_atom(_, _), L, L).
|
||||
% builtin_binds_(wait_for_input(_, _, _), L, L).
|
||||
% builtin_binds_(wildcard_match(_, _), L, L).
|
||||
% builtin_binds_(with_mutex(_, _), L, L).
|
||||
% builtin_binds_(with_output_to(_, _), L, L).
|
||||
% builtin_binds_(working_directory(_, _), L, L).
|
||||
|
||||
|
||||
% builtin_binds_(functor(Term, Functor, Arity), [Term,Functor,Arity|T], T).
|
||||
% builtin_binds_(arg(Arg, Term, Pos), [Arg,Term,Pos|T], T).
|
||||
% builtin_binds_(term_variables(_, _), L, L).
|
||||
% builtin_binds_(X=Y, [X,Y|T], T).
|
||||
|
||||
|
||||
builtin_binds_(X is _,[X|L],L).
|
||||
builtin_binds_((G1,G2),L,T) :-
|
||||
builtin_binds_(G1,L,R),
|
||||
@ -141,6 +578,10 @@ binds_(_ == _,L,L).
|
||||
binds_(_ \== _,L,L).
|
||||
binds_(true,L,L).
|
||||
|
||||
binds_(write(_),L,L).
|
||||
binds_(writeln(_),L,L).
|
||||
binds_(format(_,_),L,L).
|
||||
|
||||
binds_(X is _,[X|L],L).
|
||||
binds_((G1,G2),L,T) :-
|
||||
binds_(G1,L,R),
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_compiler_errors.pl,v 1.2 2007-10-16 23:40:07 vsc Exp $
|
||||
/* $Id: chr_compiler_errors.pl,v 1.3 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -123,6 +123,13 @@ print_chr_error(syntax(Term),Message,Params) :- !,
|
||||
format(user_error,Message,Params),
|
||||
long_line_with_equality_signs.
|
||||
|
||||
print_chr_error(type_error,Message,Params) :- !,
|
||||
long_line_with_equality_signs,
|
||||
format(user_error,'CHR compiler TYPE ERROR:\n',[]),
|
||||
format(user_error,' `--> ',[]),
|
||||
format(user_error,Message,Params),
|
||||
long_line_with_equality_signs.
|
||||
|
||||
print_chr_error(internal,Message,Params) :- !,
|
||||
long_line_with_equality_signs,
|
||||
format(user_error,'CHR compiler ERROR: something unexpected happened in the CHR compiler.\n',[]),
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_compiler_options.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_compiler_options.pl,v 1.3 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -200,6 +200,18 @@ option_definition(mode,ModeDecl,[]) :-
|
||||
option_definition(store,FA-Store,[]) :-
|
||||
chr_translate:store_type(FA,Store).
|
||||
|
||||
%------------------------------------------------------------------------------%
|
||||
option_definition(declare_stored_constraints,off,[declare_stored_constraints-off]).
|
||||
option_definition(declare_stored_constraints,on ,[declare_stored_constraints-on]).
|
||||
|
||||
option_definition(stored,F/A,[]) :-
|
||||
chr_translate:stored_assertion(F/A).
|
||||
%------------------------------------------------------------------------------%
|
||||
option_definition(experiment,off,[experiment-off]).
|
||||
option_definition(experiment,on,[experiment-on]).
|
||||
option_definition(experimental,off,[experiment-off]).
|
||||
option_definition(experimental,on,[experiment-on]).
|
||||
%------------------------------------------------------------------------------%
|
||||
option_definition(debug,off,Flags) :-
|
||||
option_definition(optimize,full,Flags2),
|
||||
Flags = [ debugable - off | Flags2].
|
||||
@ -280,6 +292,12 @@ option_definition(dynattr,on,Flags) :-
|
||||
option_definition(dynattr,off,Flags) :-
|
||||
Flags = [dynattr - off].
|
||||
|
||||
option_definition(verbose,off,[verbose-off]).
|
||||
option_definition(verbose,on,[verbose-on]).
|
||||
|
||||
option_definition(dump,off,[dump-off]).
|
||||
option_definition(dump,on,[dump-on]).
|
||||
|
||||
init_chr_pp_flags :-
|
||||
chr_pp_flag_definition(Name,[DefaultValue|_]),
|
||||
set_chr_pp_flag(Name,DefaultValue),
|
||||
@ -323,6 +341,13 @@ chr_pp_flag_definition(ht_removal,[off,on]).
|
||||
chr_pp_flag_definition(mixed_stores,[off,on]).
|
||||
chr_pp_flag_definition(line_numbers,[off,on]).
|
||||
chr_pp_flag_definition(dynattr,[off,on]).
|
||||
chr_pp_flag_definition(experiment,[off,on]).
|
||||
% emit compiler inferred code
|
||||
chr_pp_flag_definition(verbose,[off,on]).
|
||||
% emit input code and output code
|
||||
chr_pp_flag_definition(dump,[off,on]).
|
||||
|
||||
chr_pp_flag_definition(declare_stored_constraints,[off,on]).
|
||||
|
||||
chr_pp_flag(Name,Value) :-
|
||||
atom_concat('$chr_pp_',Name,GlobalVar),
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_compiler_utility.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_compiler_utility.pl,v 1.3 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -28,9 +28,9 @@
|
||||
invalidate any other reasons why the executable file might be covered by
|
||||
the GNU General Public License.
|
||||
*/
|
||||
:- if(current_prolog_flag(dialect, swi)).
|
||||
:- module(chr_compiler_utility,
|
||||
[ is_variant/2
|
||||
, time/2
|
||||
[ time/2
|
||||
, replicate/3
|
||||
, pair_all_with/3
|
||||
, conj2list/2
|
||||
@ -45,44 +45,63 @@
|
||||
, my_term_copy/3
|
||||
, my_term_copy/4
|
||||
, atom_concat_list/2
|
||||
%vsc , atomic_concat/3
|
||||
, atomic_concat/3
|
||||
, init/2
|
||||
, member2/3
|
||||
, select2/6
|
||||
, set_elems/2
|
||||
, instrument_goal/4
|
||||
, sort_by_key/3
|
||||
, arg1/3
|
||||
, wrap_in_functor/3
|
||||
, tree_set_empty/1
|
||||
, tree_set_memberchk/2
|
||||
, tree_set_add/3
|
||||
]).
|
||||
:- else.
|
||||
|
||||
% ugly: this is because YAP also has atomic_concat
|
||||
% so we cannot export it from chr_compiler_utility.
|
||||
|
||||
:- module(chr_compiler_utility,
|
||||
[ time/2
|
||||
, replicate/3
|
||||
, pair_all_with/3
|
||||
, conj2list/2
|
||||
, list2conj/2
|
||||
, disj2list/2
|
||||
, list2disj/2
|
||||
, variable_replacement/3
|
||||
, variable_replacement/4
|
||||
, identical_rules/2
|
||||
, identical_guarded_rules/2
|
||||
, copy_with_variable_replacement/3
|
||||
, my_term_copy/3
|
||||
, my_term_copy/4
|
||||
, atom_concat_list/2
|
||||
, init/2
|
||||
, member2/3
|
||||
, select2/6
|
||||
, set_elems/2
|
||||
, instrument_goal/4
|
||||
, sort_by_key/3
|
||||
, arg1/3
|
||||
, wrap_in_functor/3
|
||||
, tree_set_empty/1
|
||||
, tree_set_memberchk/2
|
||||
, tree_set_add/3
|
||||
]).
|
||||
:- endif.
|
||||
|
||||
:- use_module(pairlist).
|
||||
:- use_module(library(lists), [permutation/2]).
|
||||
:- use_module(library(assoc)).
|
||||
|
||||
%% SICStus begin
|
||||
%% use_module(library(terms),[term_variables/2]).
|
||||
%% SICStus end
|
||||
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
is_variant(A,B) :-
|
||||
copy_term_nat(A,AC),
|
||||
copy_term_nat(B,BC),
|
||||
term_variables(AC,AVars),
|
||||
term_variables(BC,BVars),
|
||||
AC = BC,
|
||||
is_variant1(AVars),
|
||||
is_variant2(BVars).
|
||||
|
||||
is_variant1([]).
|
||||
is_variant1([X|Xs]) :-
|
||||
var(X),
|
||||
X = '$test',
|
||||
is_variant1(Xs).
|
||||
|
||||
is_variant2([]).
|
||||
is_variant2([X|Xs]) :-
|
||||
X == '$test',
|
||||
is_variant2(Xs).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
% time(Phase,Goal) :-
|
||||
% statistics(runtime,[T1|_]),
|
||||
@ -260,12 +279,13 @@ atom_concat_list([X|Xs],A) :-
|
||||
atom_concat_list(Xs,B),
|
||||
atomic_concat(X,B,A).
|
||||
|
||||
/* vsc
|
||||
:- if(current_prolog_flag(dialect, swi)).
|
||||
atomic_concat(A,B,C) :-
|
||||
make_atom(A,AA),
|
||||
make_atom(B,BB),
|
||||
atom_concat(AA,BB,C).
|
||||
*/
|
||||
:- endif.
|
||||
|
||||
make_atom(A,AA) :-
|
||||
(
|
||||
atom(A) ->
|
||||
@ -301,3 +321,31 @@ sort_by_key(List,Keys,SortedList) :-
|
||||
pairup(Keys,List,Pairs),
|
||||
sort(Pairs,SortedPairs),
|
||||
once(pairup(_,SortedList,SortedPairs)).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
arg1(Term,Index,Arg) :- arg(Index,Term,Arg).
|
||||
|
||||
wrap_in_functor(Functor,X,Term) :-
|
||||
Term =.. [Functor,X].
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
tree_set_empty(TreeSet) :- empty_assoc(TreeSet).
|
||||
tree_set_memberchk(Element,TreeSet) :- get_assoc(Element,TreeSet,_).
|
||||
tree_set_add(TreeSet,Element,NTreeSet) :- put_assoc(Element,TreeSet,x,NTreeSet).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
:- dynamic
|
||||
user:goal_expansion/2.
|
||||
:- multifile
|
||||
user:goal_expansion/2.
|
||||
|
||||
user:goal_expansion(arg1(Term,Index,Arg), arg(Index,Term,Arg)).
|
||||
user:goal_expansion(wrap_in_functor(Functor,In,Out), Goal) :-
|
||||
( atom(Functor), var(Out) ->
|
||||
Out =.. [Functor,In],
|
||||
Goal = true
|
||||
;
|
||||
Goal = (Out =.. [Functor,In])
|
||||
).
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_debug.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_debug.pl,v 1.3 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_hashtable_store.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_hashtable_store.pl,v 1.3 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -35,26 +35,37 @@
|
||||
:- module(chr_hashtable_store,
|
||||
[ new_ht/1,
|
||||
lookup_ht/3,
|
||||
lookup_ht1/4,
|
||||
lookup_ht2/4,
|
||||
insert_ht/3,
|
||||
insert_ht/4,
|
||||
delete_ht/3,
|
||||
delete_ht1/4,
|
||||
delete_first_ht/3,
|
||||
value_ht/2
|
||||
value_ht/2,
|
||||
stats_ht/1,
|
||||
stats_ht/1
|
||||
]).
|
||||
|
||||
:- use_module(pairlist).
|
||||
:- use_module(hprolog).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(terms)). %yap
|
||||
|
||||
:- if(current_prolog_flag(dialect, swi)).
|
||||
:- multifile user:goal_expansion/2.
|
||||
:- dynamic user:goal_expansion/2.
|
||||
|
||||
user:goal_expansion(term_hash(Term,Hash),hash_term(Term,Hash)).
|
||||
|
||||
:- else.
|
||||
|
||||
:- use_module(library(terms), [term_hash/2]).
|
||||
|
||||
:- endif.
|
||||
|
||||
% term_hash(Term,Hash) :-
|
||||
% hash_term(Term,Hash).
|
||||
initial_capacity(1).
|
||||
initial_capacity(89).
|
||||
|
||||
new_ht(HT) :-
|
||||
initial_capacity(Capacity),
|
||||
@ -78,6 +89,31 @@ lookup_ht(HT,Key,Values) :-
|
||||
lookup(Bucket,Key,Values)
|
||||
).
|
||||
|
||||
lookup_ht1(HT,Hash,Key,Values) :-
|
||||
HT = ht(Capacity,_,Table),
|
||||
Index is (Hash mod Capacity) + 1,
|
||||
arg(Index,Table,Bucket),
|
||||
nonvar(Bucket),
|
||||
( Bucket = K-Vs ->
|
||||
K == Key,
|
||||
Values = Vs
|
||||
;
|
||||
lookup(Bucket,Key,Values)
|
||||
).
|
||||
|
||||
lookup_ht2(HT,Key,Values,Index) :-
|
||||
term_hash(Key,Hash),
|
||||
HT = ht(Capacity,_,Table),
|
||||
Index is (Hash mod Capacity) + 1,
|
||||
arg(Index,Table,Bucket),
|
||||
nonvar(Bucket),
|
||||
( Bucket = K-Vs ->
|
||||
K == Key,
|
||||
Values = Vs
|
||||
;
|
||||
lookup(Bucket,Key,Values)
|
||||
).
|
||||
|
||||
lookup_pair_eq([P | KVs],Key,Pair) :-
|
||||
P = K-_,
|
||||
( K == Key ->
|
||||
@ -115,6 +151,34 @@ insert_ht(HT,Key,Value) :-
|
||||
true
|
||||
).
|
||||
|
||||
insert_ht1(HT,Key,Hash,Value) :-
|
||||
HT = ht(Capacity0,Load,Table0),
|
||||
LookupIndex is (Hash mod Capacity0) + 1,
|
||||
arg(LookupIndex,Table0,LookupBucket),
|
||||
( var(LookupBucket) ->
|
||||
LookupBucket = Key - [Value]
|
||||
; LookupBucket = K-Values ->
|
||||
( K == Key ->
|
||||
setarg(2,LookupBucket,[Value|Values])
|
||||
;
|
||||
setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
|
||||
)
|
||||
;
|
||||
( lookup_pair_eq(LookupBucket,Key,Pair) ->
|
||||
Pair = _-Values,
|
||||
setarg(2,Pair,[Value|Values])
|
||||
;
|
||||
setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
|
||||
)
|
||||
),
|
||||
NLoad is Load + 1,
|
||||
setarg(2,HT,NLoad),
|
||||
( Load == Capacity0 ->
|
||||
expand_ht(HT,_Capacity)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
% LDK: insert version with extra argument denoting result
|
||||
|
||||
insert_ht(HT,Key,Value,Result) :-
|
||||
@ -186,11 +250,10 @@ delete_ht(HT,Key,Value) :-
|
||||
term_hash(Key,Hash),
|
||||
Index is (Hash mod Capacity) + 1,
|
||||
arg(Index,Table,Bucket),
|
||||
( var(Bucket) ->
|
||||
( /* var(Bucket) ->
|
||||
true
|
||||
;
|
||||
( Bucket = K-Vs ->
|
||||
( K == Key,
|
||||
; */ Bucket = _K-Vs ->
|
||||
( /* _K == Key, */
|
||||
delete_first_fail(Vs,Value,NVs) ->
|
||||
setarg(2,HT,NLoad),
|
||||
( NVs == [] ->
|
||||
@ -219,7 +282,6 @@ delete_ht(HT,Key,Value) :-
|
||||
;
|
||||
true
|
||||
)
|
||||
)
|
||||
).
|
||||
|
||||
delete_first_fail([X | Xs], Y, Zs) :-
|
||||
@ -229,6 +291,46 @@ delete_first_fail([X | Xs], Y, Zs) :-
|
||||
Zs = [X | Zs1],
|
||||
delete_first_fail(Xs, Y, Zs1)
|
||||
).
|
||||
|
||||
delete_ht1(HT,Key,Value,Index) :-
|
||||
HT = ht(_Capacity,Load,Table),
|
||||
NLoad is Load - 1,
|
||||
% term_hash(Key,Hash),
|
||||
% Index is (Hash mod _Capacity) + 1,
|
||||
arg(Index,Table,Bucket),
|
||||
( /* var(Bucket) ->
|
||||
true
|
||||
; */ Bucket = _K-Vs ->
|
||||
( /* _K == Key, */
|
||||
delete_first_fail(Vs,Value,NVs) ->
|
||||
setarg(2,HT,NLoad),
|
||||
( NVs == [] ->
|
||||
setarg(Index,Table,_)
|
||||
;
|
||||
setarg(2,Bucket,NVs)
|
||||
)
|
||||
;
|
||||
true
|
||||
)
|
||||
;
|
||||
( lookup_pair_eq(Bucket,Key,Pair),
|
||||
Pair = _-Vs,
|
||||
delete_first_fail(Vs,Value,NVs) ->
|
||||
setarg(2,HT,NLoad),
|
||||
( NVs == [] ->
|
||||
pairlist_delete_eq(Bucket,Key,NBucket),
|
||||
( NBucket = [Singleton] ->
|
||||
setarg(Index,Table,Singleton)
|
||||
;
|
||||
setarg(Index,Table,NBucket)
|
||||
)
|
||||
;
|
||||
setarg(2,Pair,NVs)
|
||||
)
|
||||
;
|
||||
true
|
||||
)
|
||||
).
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
value_ht(HT,Value) :-
|
||||
HT = ht(Capacity,_,Table),
|
||||
@ -254,7 +356,7 @@ value_ht(I,N,Table,Value) :-
|
||||
|
||||
expand_ht(HT,NewCapacity) :-
|
||||
HT = ht(Capacity,_,Table),
|
||||
NewCapacity is Capacity * 2,
|
||||
NewCapacity is Capacity * 2 + 1,
|
||||
functor(NewTable,t,NewCapacity),
|
||||
setarg(1,HT,NewCapacity),
|
||||
setarg(3,HT,NewTable),
|
||||
@ -293,4 +395,17 @@ expand_insert(Table,Capacity,K,V) :-
|
||||
setarg(Index,Table,[K-V|Bucket])
|
||||
).
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
stats_ht(HT) :-
|
||||
HT = ht(Capacity,Load,Table),
|
||||
format('HT load = ~w / ~w\n',[Load,Capacity]),
|
||||
( between(1,Capacity,Index),
|
||||
arg(Index,Table,Entry),
|
||||
( var(Entry) -> Size = 0
|
||||
; Entry = _-_ -> Size = 1
|
||||
; length(Entry,Size)
|
||||
),
|
||||
format('~w : ~w\n',[Index,Size]),
|
||||
fail
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_integertable_store.pl,v 1.2 2007-10-16 23:40:07 vsc Exp $
|
||||
/* $Id: chr_integertable_store.pl,v 1.3 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_messages.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_messages.pl,v 1.3 2008-03-13 14:37:59 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_op.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_op.pl,v 1.3 2008-03-13 14:38:00 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -47,3 +47,4 @@
|
||||
:- op(1150, fx, chr_type).
|
||||
:- op(1130, xfx, --->).
|
||||
:- op(1150, fx, (?)).
|
||||
:- op(1150, fx, chr_declaration).
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_op2.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_op2.pl,v 1.3 2008-03-13 14:38:00 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_runtime.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_runtime.pl,v 1.3 2008-03-13 14:38:00 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_swi.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_swi.pl,v 1.3 2008-03-13 14:38:00 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -43,6 +43,7 @@
|
||||
op(1190, xfx, pragma),
|
||||
op( 500, yfx, #),
|
||||
op(1150, fx, chr_type),
|
||||
op(1150, fx, chr_declaration),
|
||||
op(1130, xfx, --->),
|
||||
op(1150, fx, (?)),
|
||||
chr_show_store/1, % +Module
|
||||
@ -130,6 +131,7 @@ chr_expandable((constraints _)).
|
||||
chr_expandable((:- chr_constraint _)).
|
||||
chr_expandable((:- chr_type _)).
|
||||
chr_expandable((chr_type _)).
|
||||
chr_expandable((:- chr_declaration _)).
|
||||
chr_expandable(option(_, _)).
|
||||
chr_expandable((:- chr_option(_, _))).
|
||||
chr_expandable((handler _)).
|
||||
@ -165,7 +167,7 @@ chr_expand(Term, []) :-
|
||||
add_pragma_to_chr_rule(Term,line_number(LineNumber),NTerm),
|
||||
assert(chr_term(File, LineNumber, NTerm)).
|
||||
chr_expand(Term, []) :-
|
||||
Term = (:- chr_preprocessor(Preprocessor)), !,
|
||||
Term = ((:- chr_preprocessor Preprocessor)), !,
|
||||
prolog_load_context(file,File),
|
||||
assert(chr_pp(File, Preprocessor)).
|
||||
chr_expand(end_of_file, FinalProgram) :-
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_swi_bootstrap.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_swi_bootstrap.pl,v 1.3 2008-03-13 14:38:00 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -76,7 +76,7 @@ chr_compile(From, To, MsgLevel) :-
|
||||
print_message(MsgLevel, chr(end(From, To))).
|
||||
|
||||
|
||||
%% SWI begin with yap change
|
||||
%% SWI begin
|
||||
specific_declarations([(:- use_module('chr_runtime')),
|
||||
(:- style_check(-discontiguous))|Tail], Tail).
|
||||
%% SWI end
|
||||
@ -130,7 +130,8 @@ writeheader(File, Out) :-
|
||||
format_date(Out) :-
|
||||
get_time(Now),
|
||||
convert_time(Now, Date),
|
||||
format(Out, ' Date: ~s~n~n', [Date]). % yap change
|
||||
% vsc: this is a string
|
||||
format(Out, ' Date: ~s~n~n', [Date]).
|
||||
%% SWI end
|
||||
|
||||
%% SICStus begin
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_test.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_test.pl,v 1.3 2008-03-13 14:38:00 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_translate_bootstrap.pl,v 1.5 2008-02-23 01:32:30 vsc Exp $
|
||||
/* $Id: chr_translate_bootstrap.pl,v 1.6 2008-03-13 14:38:00 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -122,7 +122,7 @@
|
||||
[ chr_translate/2 % +Decls, -TranslatedDecls
|
||||
]).
|
||||
%% SWI begin
|
||||
:- use_module(library(lists),[member/2,append/3,permutation/2,reverse/2]).
|
||||
:- use_module(library(lists),[member/2,append/3,append/2,permutation/2,reverse/2]).
|
||||
:- use_module(library(ordsets)).
|
||||
%% SWI end
|
||||
:- use_module(hprolog).
|
||||
@ -536,13 +536,13 @@ generate_attach_a_constraint_t_p(Total,Position,CFct / CAty ,Mod,Clause) :-
|
||||
RecursiveCall =.. [Fct,Vars,Susp],
|
||||
or_pattern(Position,Pattern),
|
||||
make_attr(Total,Mask,SuspsList,Attr),
|
||||
nth(Position,SuspsList,Susps),
|
||||
nth1(Position,SuspsList,Susps),
|
||||
substitute_eq(Susps,SuspsList,[Susp|Susps],SuspsList1),
|
||||
make_attr(Total,Mask,SuspsList1,NewAttr1),
|
||||
substitute_eq(Susps,SuspsList,[Susp],SuspsList2),
|
||||
make_attr(Total,NewMask,SuspsList2,NewAttr2),
|
||||
copy_term_nat(SuspsList,SuspsList3),
|
||||
nth(Position,SuspsList3,[Susp]),
|
||||
nth1(Position,SuspsList3,[Susp]),
|
||||
chr_delete(SuspsList3,[Susp],RestSuspsList),
|
||||
set_elems(RestSuspsList,[]),
|
||||
make_attr(Total,Pattern,SuspsList3,NewAttr3),
|
||||
@ -609,6 +609,7 @@ generate_detach_a_constraint_1_1(CFct / CAty,Mod,Clause) :-
|
||||
RecursiveCall
|
||||
),
|
||||
Clause = (Head :- Body).
|
||||
|
||||
generate_detach_a_constraint_t_p(Total,Position,CFct / CAty ,Mod,Clause) :-
|
||||
atom_concat_list(['detach_',CFct, (/) ,CAty],Fct),
|
||||
Args = [[Var|Vars],Susp],
|
||||
@ -617,7 +618,7 @@ generate_detach_a_constraint_t_p(Total,Position,CFct / CAty ,Mod,Clause) :-
|
||||
or_pattern(Position,Pattern),
|
||||
and_pattern(Position,DelPattern),
|
||||
make_attr(Total,Mask,SuspsList,Attr),
|
||||
nth(Position,SuspsList,Susps),
|
||||
nth1(Position,SuspsList,Susps),
|
||||
substitute_eq(Susps,SuspsList,[],SuspsList1),
|
||||
make_attr(Total,NewMask,SuspsList1,Attr1),
|
||||
substitute_eq(Susps,SuspsList,NewSusps,SuspsList2),
|
||||
@ -1419,9 +1420,9 @@ rest_heads_retrieval_and_matching_n([H|Hs],[ID|IDs],Pragmas,PrevHs,PrevSusps,Act
|
||||
( N == 1 ->
|
||||
VarSusps = Attr
|
||||
;
|
||||
nth(Pos,Constraints,Fct/Aty), !,
|
||||
nth1(Pos,Constraints,Fct/Aty), !,
|
||||
make_attr(N,_Mask,SuspsList,Attr),
|
||||
nth(Pos,SuspsList,VarSusps)
|
||||
nth1(Pos,SuspsList,VarSusps)
|
||||
),
|
||||
different_from_other_susps(H,Susp,PrevHs,PrevSusps,DiffSuspGoals),
|
||||
create_get_mutable_ref(active,State,GetMutable),
|
||||
@ -1460,7 +1461,7 @@ check_unique_keys([V|Vs],Dict) :-
|
||||
|
||||
% Generates tests to ensure the found constraint differs from previously found constraints
|
||||
different_from_other_susps(Head,Susp,Heads,Susps,DiffSuspGoals) :-
|
||||
( bagof(DiffSuspGoal, Pos ^ ( nth(Pos,Heads,PreHead), \+ Head \= PreHead, nth(Pos,Susps,PreSusp), DiffSuspGoal = (Susp \== PreSusp) ),DiffSuspGoalList) ->
|
||||
( bagof(DiffSuspGoal, Pos ^ ( nth1(Pos,Heads,PreHead), \+ Head \= PreHead, nth1(Pos,Susps,PreSusp), DiffSuspGoal = (Susp \== PreSusp) ),DiffSuspGoalList) ->
|
||||
list2conj(DiffSuspGoalList,DiffSuspGoals)
|
||||
;
|
||||
DiffSuspGoals = true
|
||||
@ -1468,7 +1469,7 @@ different_from_other_susps(Head,Susp,Heads,Susps,DiffSuspGoals) :-
|
||||
|
||||
passive_head_via(Head,PrevHeads,AttrDict,Constraints,Mod,VarDict,Goal,Attr,NewAttrDict) :-
|
||||
functor(Head,F,A),
|
||||
nth(Pos,Constraints,F/A),!,
|
||||
nth1(Pos,Constraints,F/A),!,
|
||||
common_variables(Head,PrevHeads,CommonVars),
|
||||
translate(CommonVars,VarDict,Vars),
|
||||
or_pattern(Pos,Bit),
|
||||
@ -1699,9 +1700,9 @@ simpagation_head2_prelude(Head,Head1,Rest,F/A,_I,N,Constraints,Mod,Id1,L,T) :-
|
||||
AllSusps = Attr
|
||||
;
|
||||
functor(Head1,F1,A1),
|
||||
nth(Pos,Constraints,F1/A1), !,
|
||||
nth1(Pos,Constraints,F1/A1), !,
|
||||
make_attr(N,_,SuspsList,Attr),
|
||||
nth(Pos,SuspsList,AllSusps)
|
||||
nth1(Pos,SuspsList,AllSusps)
|
||||
),
|
||||
|
||||
( Id1 == [0] -> % create suspension
|
||||
@ -1941,8 +1942,8 @@ propagation_prelude(Head,[First|Rest],Rule,F/A,N,Constraints,Mod,Id,L,T) :-
|
||||
;
|
||||
functor(First,FirstFct,FirstAty),
|
||||
make_attr(N,_Mask,SuspsList,Attr),
|
||||
nth(Pos,Constraints,FirstFct/FirstAty), !,
|
||||
nth(Pos,SuspsList,Susps)
|
||||
nth1(Pos,Constraints,FirstFct/FirstAty), !,
|
||||
nth1(Pos,SuspsList,Susps)
|
||||
),
|
||||
|
||||
( Id == [0] ->
|
||||
@ -2120,9 +2121,9 @@ propagation_accumulator([NextHead|RestHeads],[CurrentHead|PreHeads],Rule,F/A,N,C
|
||||
( N == 1 ->
|
||||
NextSusps = Attr
|
||||
;
|
||||
nth(Position,Constraints,NextF/NextA), !,
|
||||
nth1(Position,Constraints,NextF/NextA), !,
|
||||
make_attr(N,_Mask,SuspsList,Attr),
|
||||
nth(Position,SuspsList,NextSusps)
|
||||
nth1(Position,SuspsList,NextSusps)
|
||||
),
|
||||
inc_id(Id,NestedId),
|
||||
ClauseVars = [[OtherSusp|OtherSusps]|PreVarsAndSusps],
|
||||
@ -2286,6 +2287,7 @@ create_get_mutable_ref(V,M,GM) :- GM = (M = mutable(V)).
|
||||
%% SICStus end
|
||||
|
||||
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
@ -2456,6 +2458,8 @@ list2conj([G|Gs],C) :-
|
||||
list2conj(Gs,R)
|
||||
).
|
||||
|
||||
:- if(current_prolog_flag(dialect, swi)).
|
||||
|
||||
atom_concat_list([X],X) :- ! .
|
||||
atom_concat_list([X|Xs],A) :-
|
||||
atom_concat_list(Xs,B),
|
||||
@ -2476,6 +2480,12 @@ make_atom(A,AA) :-
|
||||
atom_codes(AA,AL)
|
||||
).
|
||||
|
||||
:- else.
|
||||
|
||||
atom_concat_list(L,X) :-
|
||||
atomic_concat(L, X).
|
||||
|
||||
:- endif.
|
||||
|
||||
set_elems([],_).
|
||||
set_elems([X|Xs],X) :-
|
||||
@ -2505,4 +2515,3 @@ verbosity_on :- prolog_flag(verbose,V), V == yes.
|
||||
%% SICStus begin
|
||||
%% verbosity_on. % at the moment
|
||||
%% SICStus end
|
||||
|
||||
|
||||
@ -14,6 +14,7 @@
|
||||
:- style_check(- (discontiguous)).
|
||||
:- use_module(library(lists),
|
||||
[ append/3,
|
||||
append/2,
|
||||
member/2,
|
||||
permutation/2,
|
||||
reverse/2
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: chr_translate_bootstrap2.chr,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: chr_translate_bootstrap2.chr,v 1.3 2008-03-13 14:38:01 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -113,7 +113,7 @@
|
||||
[ chr_translate/2 % +Decls, -TranslatedDecls
|
||||
]).
|
||||
%% SWI begin
|
||||
:- use_module(library(lists),[append/3,member/2,delete/3,reverse/2,permutation/2]).
|
||||
:- use_module(library(lists),[append/3,append/2,member/2,delete/3,reverse/2,permutation/2,min_list/2]).
|
||||
:- use_module(library(ordsets)).
|
||||
%% SWI end
|
||||
|
||||
@ -410,7 +410,7 @@ store_management_preds(Constraints,Clauses) :-
|
||||
,Clauses).
|
||||
|
||||
|
||||
%% SWI begin vsc: yap changes
|
||||
%% SWI begin
|
||||
specific_declarations([(:- use_module('chr_runtime'))
|
||||
,(:- use_module('chr_hashtable_store'))
|
||||
,(:- style_check(-discontiguous))
|
||||
@ -3558,6 +3558,8 @@ list2disj([G|Gs],C) :-
|
||||
list2disj(Gs,R)
|
||||
).
|
||||
|
||||
:- if(current_prolog_flag(dialect, swi)).
|
||||
|
||||
atom_concat_list([X],X) :- ! .
|
||||
atom_concat_list([X|Xs],A) :-
|
||||
atom_concat_list(Xs,B),
|
||||
@ -3577,6 +3579,12 @@ make_atom(A,AA) :-
|
||||
number_codes(A,AL),
|
||||
atom_codes(AA,AL)
|
||||
).
|
||||
:- else.
|
||||
|
||||
atom_concat_list(L,X) :-
|
||||
atomic_concat(L, X).
|
||||
|
||||
:- endif.
|
||||
|
||||
|
||||
make_name(Prefix,F/A,Name) :-
|
||||
|
||||
@ -10,10 +10,9 @@
|
||||
%% \____\___/ \__,_|\___| \____|_|\___|\__,_|_| |_|_|_| |_|\__, |
|
||||
%% |___/
|
||||
%%
|
||||
%% removes redundant 'true's and other trivial but potentially non-free constructs
|
||||
|
||||
% TODO
|
||||
% Remove last clause with Body = fail
|
||||
%%
|
||||
%% To be done:
|
||||
%% inline clauses
|
||||
|
||||
:- module(clean_code,
|
||||
[
|
||||
@ -22,10 +21,24 @@
|
||||
|
||||
:- use_module(hprolog).
|
||||
|
||||
clean_clauses([],[]).
|
||||
clean_clauses([C|Cs],[NC|NCs]) :-
|
||||
clean_clauses(Clauses,NClauses) :-
|
||||
clean_clauses1(Clauses,Clauses1),
|
||||
merge_clauses(Clauses1,NClauses).
|
||||
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
% CLEAN CLAUSES
|
||||
%
|
||||
% - move neck unification into the head of the clause
|
||||
% - drop true body
|
||||
% - specialize control flow goal wrt true and fail
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
clean_clauses1([],[]).
|
||||
clean_clauses1([C|Cs],[NC|NCs]) :-
|
||||
clean_clause(C,NC),
|
||||
clean_clauses(Cs,NCs).
|
||||
clean_clauses1(Cs,NCs).
|
||||
|
||||
clean_clause(Clause,NClause) :-
|
||||
( Clause = (Head :- Body) ->
|
||||
@ -128,20 +141,6 @@ move_unification_into_head_([G|Gs],Head,NHead,NBody) :-
|
||||
list2conj([G|Gs],NBody)
|
||||
).
|
||||
|
||||
% move_unification_into_head(Head,Body,NHead,NBody) :-
|
||||
% ( Body = (X = Y, More) ; Body = (X = Y), More = true), !,
|
||||
% ( var(X), term_variables(More,MoreVars), \+ memberchk_eq(X,MoreVars) ->
|
||||
% X = Y,
|
||||
% move_unification_into_head(Head,More,NHead,NBody)
|
||||
% ; var(Y) ->
|
||||
% move_unification_into_head(Head,(Y = X,More),NHead,NBody)
|
||||
% ;
|
||||
% NHead = Head,
|
||||
% NBody = Body
|
||||
% ).
|
||||
%
|
||||
% move_unification_into_head(Head,Body,Head,Body).
|
||||
|
||||
|
||||
conj2list(Conj,L) :- %% transform conjunctions to list
|
||||
conj2list(Conj,L,[]).
|
||||
@ -165,3 +164,61 @@ list2conj([G|Gs],C) :-
|
||||
C = (G,R),
|
||||
list2conj(Gs,R)
|
||||
).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
% MERGE CLAUSES
|
||||
%
|
||||
% Find common prefixes of successive clauses and share them.
|
||||
%
|
||||
% Note: we assume that the prefix does not generate a side effect.
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
merge_clauses([],[]).
|
||||
merge_clauses([C],[C]).
|
||||
merge_clauses([X,Y|Clauses],NClauses) :-
|
||||
( merge_two_clauses(X,Y,Clause) ->
|
||||
merge_clauses([Clause|Clauses],NClauses)
|
||||
;
|
||||
NClauses = [X|RClauses],
|
||||
merge_clauses([Y|Clauses],RClauses)
|
||||
).
|
||||
|
||||
merge_two_clauses('$source_location'(F1,L1) : C1,
|
||||
'$source_location'(_F2,_L2) : C2,
|
||||
Result) :- !,
|
||||
merge_two_clauses(C1,C2,C),
|
||||
Result = '$source_location'(F1,L1) : C.
|
||||
merge_two_clauses((H1 :- B1), (H2 :- B2), (H :- B)) :-
|
||||
H1 =@= H2,
|
||||
H1 = H,
|
||||
conj2list(B1,List1),
|
||||
conj2list(B2,List2),
|
||||
merge_lists(List1,List2,H1,H2,Unifier,List,NList1,NList2),
|
||||
List \= [],
|
||||
H1 = H2,
|
||||
call(Unifier),
|
||||
list2conj(List,Prefix),
|
||||
list2conj(NList1,NB1),
|
||||
( NList2 == (!) ->
|
||||
B = Prefix
|
||||
;
|
||||
list2conj(NList2,NB2),
|
||||
B = (Prefix,(NB1 ; NB2))
|
||||
).
|
||||
|
||||
merge_lists([],[],_,_,true,[],[],[]).
|
||||
merge_lists([],L2,_,_,true,[],[],L2).
|
||||
merge_lists([!|Xs],_,_,_,true,[!|Xs],[],!) :- !.
|
||||
merge_lists([X|Xs],[],_,_,true,[],[X|Xs],[]).
|
||||
merge_lists([X|Xs],[Y|Ys],H1,H2,Unifier,Common,N1,N2) :-
|
||||
( H1-X =@= H2-Y ->
|
||||
Unifier = (X = Y, RUnifier),
|
||||
Common = [X|NCommon],
|
||||
merge_lists(Xs,Ys,H1/X,H2/Y,RUnifier,NCommon,N1,N2)
|
||||
;
|
||||
Unifier = true,
|
||||
Common = [],
|
||||
N1 = [X|Xs],
|
||||
N2 = [Y|Ys]
|
||||
).
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: find.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: find.pl,v 1.3 2008-03-13 14:38:01 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
@ -61,3 +61,15 @@ forall(X,L,G) :-
|
||||
forsome(X,L,G) :-
|
||||
member(X,L),
|
||||
call(G), !.
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
:- dynamic
|
||||
user:goal_expansion/2.
|
||||
:- multifile
|
||||
user:goal_expansion/2.
|
||||
|
||||
user:goal_expansion(forall(Element,List,Test), GoalOut) :-
|
||||
nonvar(Test),
|
||||
Test =.. [Functor,Arg],
|
||||
Arg == Element,
|
||||
GoalOut = once(maplist(Functor,List)).
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,7 +1,5 @@
|
||||
:- module(hprolog,
|
||||
[ append/2, % +ListOfLists, -List
|
||||
nth/3, % ?Index, ?List, ?Element
|
||||
substitute_eq/4, % +OldVal, +OldList, +NewVal, -NewList
|
||||
[ substitute_eq/4, % +OldVal, +OldList, +NewVal, -NewList
|
||||
memberchk_eq/2, % +Val, +List
|
||||
intersect_eq/3, % +List1, +List2, -Intersection
|
||||
list_difference_eq/3, % +List, -Subtract, -Rest
|
||||
@ -12,7 +10,6 @@
|
||||
or_list/2, % +ListOfInts, -BitwiseOr
|
||||
sublist/2, % ?Sublist, +List
|
||||
bounded_sublist/3, % ?Sublist, +List, +Bound
|
||||
min_list/2,
|
||||
chr_delete/3,
|
||||
init_store/2,
|
||||
get_store/2,
|
||||
@ -53,27 +50,6 @@ make_update_store_goal(Name,Value,Goal) :- Goal = b_setval(Name,Value).
|
||||
* MORE LIST OPERATIONS *
|
||||
*******************************/
|
||||
|
||||
% append(+ListOfLists, -List)
|
||||
%
|
||||
% Convert a one-level nested list into a flat one. E.g.
|
||||
% append([[a,b], [c]], X) --> X = [a,b,c]. See also
|
||||
% flatten/3.
|
||||
|
||||
append([],[]).
|
||||
append([X],X) :- !.
|
||||
append([X|Xs],L) :-
|
||||
append(X,T,L),
|
||||
append(Xs,T).
|
||||
|
||||
|
||||
% nth(?Index, ?List, ?Element)
|
||||
%
|
||||
% Same as nth1/3
|
||||
|
||||
nth(Index, List, Element) :-
|
||||
nth1(Index, List, Element).
|
||||
|
||||
|
||||
% substitute_eq(+OldVal, +OldList, +NewVal, -NewList)
|
||||
%
|
||||
% Substitute OldVal by NewVal in OldList and unify the result
|
||||
@ -204,15 +180,6 @@ bounded_sublist(Sublist,[H|List],Bound) :-
|
||||
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
min_list([H|T], Min) :-
|
||||
'$min_list1'(T, H, Min).
|
||||
|
||||
'$min_list1'([], Min, Min).
|
||||
'$min_list1'([H|T], X, Min) :-
|
||||
( H>=X ->
|
||||
'$min_list1'(T, X, Min)
|
||||
; '$min_list1'(T, H, Min)
|
||||
).
|
||||
|
||||
chr_delete([], _, []).
|
||||
chr_delete([H|T], X, L) :-
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
/* $Id: listmap.pl,v 1.2 2007-10-16 23:17:03 vsc Exp $
|
||||
/* $Id: listmap.pl,v 1.3 2008-03-13 14:38:01 vsc Exp $
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
|
||||
@ -593,6 +593,7 @@ install_unix: startup libYap.a
|
||||
@INSTALL_DLLS@ $(INSTALL_DATA) -m 755 @YAPLIB@ $(DESTDIR)$(LIBDIR)
|
||||
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
|
||||
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl
|
||||
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/swi
|
||||
for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
|
||||
@INSTALL_DLLS@ (cd library/random; make install)
|
||||
@INSTALL_DLLS@ (cd library/regex; make install)
|
||||
|
||||
@ -52,6 +52,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
|
||||
$(srcdir)/readutil.yap \
|
||||
$(srcdir)/regexp.yap \
|
||||
$(srcdir)/splay.yap \
|
||||
$(srcdir)/stringutils.yap \
|
||||
$(srcdir)/swi.yap \
|
||||
$(srcdir)/system.yap \
|
||||
$(srcdir)/terms.yap \
|
||||
|
||||
101
library/swi.yap
101
library/swi.yap
@ -15,16 +15,63 @@
|
||||
|
||||
:- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
|
||||
|
||||
:- use_module(library(lists),[nth/3]).
|
||||
:- use_module(library(lists),[append/3,
|
||||
delete/3,
|
||||
member/2,
|
||||
memberchk/2,
|
||||
min_list/2,
|
||||
nth/3]).
|
||||
|
||||
:- use_module(library(system),[datime/1,
|
||||
:- use_module(library(system),
|
||||
[datime/1,
|
||||
mktime/2]).
|
||||
|
||||
:- use_module(library(terms),[term_variables/2,
|
||||
:- use_module(library(arg),
|
||||
[genarg/3]).
|
||||
|
||||
:- use_module(library(terms),
|
||||
[subsumes/2,
|
||||
term_variables/2,
|
||||
term_variables/3,
|
||||
term_hash/2,
|
||||
unifiable/3,
|
||||
variant/2]).
|
||||
|
||||
:- unhide('$system_library_directories'),
|
||||
unhide('$dir_separator').
|
||||
|
||||
% make sure we also use
|
||||
:- user:library_directory(X),
|
||||
atom(X),
|
||||
atom_concat([X,'/swi'],SwiDir),
|
||||
\+ user:library_directory(SwiDir),
|
||||
asserta(user:library_directory(SwiDir)),
|
||||
fail
|
||||
;
|
||||
true.
|
||||
|
||||
:- use_module(library(maplist)).
|
||||
|
||||
:- multifile swi_predicate_table/4.
|
||||
|
||||
swi_predicate_table(_,maplist(X,Y),maplist,maplist(X,Y)).
|
||||
swi_predicate_table(_,maplist(X,Y,Z),maplist,maplist(X,Y,Z)).
|
||||
swi_predicate_table(_,maplist(X,Y,Z,W),maplist,maplist(X,Y,Z,W)).
|
||||
swi_predicate_table(_,is_list(X),lists,is_list(X)).
|
||||
swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)).
|
||||
swi_predicate_table(_,nth(X,Y,Z),lists,nth(X,Y,Z)).
|
||||
swi_predicate_table(_,delete(X,Y,Z),lists,delete(X,Y,Z)).
|
||||
swi_predicate_table(_,nth1(X,Y,Z),lists,nth(X,Y,Z)).
|
||||
swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)).
|
||||
swi_predicate_table(_,member(X,Y),lists,member(X,Y)).
|
||||
swi_predicate_table(_,append(X,Y,Z),lists,append(X,Y,Z)).
|
||||
swi_predicate_table(_,select(X,Y,Z),lists,select(X,Y,Z)).
|
||||
swi_predicate_table(_,term_variables(X,Y),terms,term_variables(X,Y)).
|
||||
swi_predicate_table(_,term_variables(X,Y,Z),terms,term_variables(X,Y,Z)).
|
||||
swi_predicate_table(_,subsumes(X,Y),terms,subsumes(X,Y)).
|
||||
swi_predicate_table(_,unifiable(X,Y,Z),terms,unifiable(X,Y,Z)).
|
||||
swi_predicate_table(_,genarg(X,Y,Z),arg,genarg(X,Y,Z)).
|
||||
|
||||
:- dynamic
|
||||
prolog:message/3.
|
||||
|
||||
@ -37,10 +84,6 @@
|
||||
:- dynamic
|
||||
user:file_search_path/2.
|
||||
|
||||
prolog:is_list(L) :- var(L), !, fail.
|
||||
prolog:is_list([]).
|
||||
prolog:is_list([_|List]) :- prolog:is_list(List).
|
||||
|
||||
user:file_search_path(swi, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
user:file_search_path(foreign, swi(ArchLib)) :-
|
||||
@ -172,8 +215,6 @@ add_separator_to_list([H|T], Separator, [H,Separator|NT]) :-
|
||||
|
||||
prolog:setenv(X,Y) :- unix(putenv(X,Y)).
|
||||
|
||||
prolog:nth1(I,L,A) :- nth(I,L,A).
|
||||
|
||||
prolog:prolog_to_os_filename(X,X).
|
||||
|
||||
prolog:is_absolute_file_name(X) :-
|
||||
@ -238,26 +279,6 @@ cvt_bindings([[Name|Value]|L],[AName=Value|Bindings]) :-
|
||||
|
||||
'$messages':prolog_message(_,L,L).
|
||||
|
||||
prolog:append([],L,L).
|
||||
prolog:append([X|L0],L,[X|Lf]) :-
|
||||
prolog:append(L0,L,Lf).
|
||||
|
||||
prolog:member(X,[X|_]).
|
||||
prolog:member(X,[_|L0]) :-
|
||||
prolog:member(X,L0).
|
||||
|
||||
prolog:select(Element, [Element|Rest], Rest).
|
||||
prolog:select(Element, [Head|Tail], [Head|Rest]) :-
|
||||
prolog:select(Element, Tail, Rest).
|
||||
|
||||
tv(Term,List) :- term_variables(Term,List).
|
||||
|
||||
prolog:term_variables(Term,List) :- tv(Term,List).
|
||||
|
||||
tv(Term,List,Tail) :- term_variables(Term,List,Tail).
|
||||
|
||||
prolog:term_variables(Term,List,Tail) :- tv(Term,List,Tail).
|
||||
|
||||
prolog:working_directory(OCWD,NCWD) :-
|
||||
getcwd(OCWD),
|
||||
(var(NCWD) -> true ; cd(NCWD)).
|
||||
@ -284,34 +305,12 @@ prolog:atom_concat(A,B,C) :- atomic_concat(A,B,C).
|
||||
|
||||
prolog:hash_term(X,Y) :- term_hash(X,Y).
|
||||
|
||||
:- meta_predicate prolog:maplist(:,?), prolog:maplist(:,?,?), prolog:maplist(:,?,?).
|
||||
|
||||
|
||||
prolog:maplist(_, []).
|
||||
prolog:maplist(G, [H|L]) :-
|
||||
call(G,H),
|
||||
prolog:maplist(G, L).
|
||||
|
||||
prolog:maplist(_, [], []).
|
||||
prolog:maplist(G, [H1|L1], [H2|L2]) :-
|
||||
call(G,H1,H2),
|
||||
prolog:maplist(G, L1, L2).
|
||||
|
||||
prolog:maplist(_, [], [], []).
|
||||
prolog:maplist(G, [H1|L1], [H2|L2], [H3|L3]) :-
|
||||
call(G,H1,H2,H3),
|
||||
prolog:maplist(G, L1, L2, L3).
|
||||
|
||||
prolog:make.
|
||||
|
||||
prolog:source_location(File,Line) :-
|
||||
prolog_load_context(file, File),
|
||||
prolog_load_context(term_position, '$stream_position'(_,Line,_)).
|
||||
|
||||
prolog:memberchk(Element, [Element|_]) :- !.
|
||||
prolog:memberchk(Element, [_|Rest]) :-
|
||||
prolog:memberchk(Element, Rest).
|
||||
|
||||
% copied from SWI lists library.
|
||||
prolog:intersection([], _, []) :- !.
|
||||
prolog:intersection([X|T], L, Intersect) :-
|
||||
|
||||
@ -21,6 +21,7 @@
|
||||
term_variables/2,
|
||||
term_variables/3,
|
||||
variant/2,
|
||||
unifiable/3,
|
||||
subsumes/2,
|
||||
subsumes_chk/2,
|
||||
cyclic_term/1,
|
||||
@ -37,7 +38,9 @@ term_hash(T,H) :-
|
||||
subsumes_chk(X,Y) :-
|
||||
\+ \+ subsumes(X,Y).
|
||||
|
||||
|
||||
unifiable(X,Y,Z) :-
|
||||
protected_unifiable(X,Y,Z), !.
|
||||
unifiable(_,_,_) :- fail.
|
||||
|
||||
|
||||
|
||||
|
||||
50
pl/arith.yap
50
pl/arith.yap
@ -30,51 +30,47 @@ compile_expressions :- set_value('$c_arith',true).
|
||||
|
||||
do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
|
||||
'$c_built_in'(IN, M, OUT, MT) :-
|
||||
'$c_built_in'(IN, M, OUT) :-
|
||||
get_value('$c_arith',true), !,
|
||||
'$do_c_built_in'(IN, M, OUT, MT).
|
||||
'$c_built_in'(IN, _, IN, _).
|
||||
'$do_c_built_in'(IN, M, OUT).
|
||||
'$c_built_in'(IN, _, IN).
|
||||
|
||||
|
||||
'$do_c_built_in'(G, M, OUT, MT) :- var(G), !,
|
||||
(MT = on -> NG = G ; NG = M:G),
|
||||
'$do_c_built_in'(call(NG), M, OUT, MT).
|
||||
'$do_c_built_in'(Mod:G, _, GN, MT) :- !,
|
||||
'$do_c_built_in'(G, Mod, GN0, MT),
|
||||
'$do_c_built_in'(G, M, OUT) :- var(G), !,
|
||||
'$do_c_built_in'(call(G), M, OUT).
|
||||
'$do_c_built_in'(Mod:G, _, GN) :- !,
|
||||
'$do_c_built_in'(G, Mod, GN0),
|
||||
(GN0 = (_,_) -> GN = GN0 ; GN = Mod:GN0).
|
||||
'$do_c_built_in'(\+ G, _, OUT, _) :-
|
||||
'$do_c_built_in'(\+ G, _, OUT) :-
|
||||
nonvar(G),
|
||||
G = (A = B),
|
||||
!,
|
||||
OUT = (A \= B).
|
||||
'$do_c_built_in'(call(G), _, OUT, _) :-
|
||||
'$do_c_built_in'(call(G), _, OUT) :-
|
||||
nonvar(G),
|
||||
G = (Mod:G1), !,
|
||||
'$do_c_built_metacall'(G1, Mod, OUT).
|
||||
'$do_c_built_in'(call(G), M, OUT, off) :-
|
||||
var(G), !,
|
||||
'$do_c_built_metacall'(G, M, OUT).
|
||||
'$do_c_built_in'(depth_bound_call(G,D), M, OUT, MT) :- !,
|
||||
'$do_c_built_in'(G, M, NG, MT),
|
||||
'$do_c_built_in'(depth_bound_call(G,D), M, OUT) :- !,
|
||||
'$do_c_built_in'(G, M, NG),
|
||||
% make sure we don't have something like (A,B) -> $depth_next(D), A, B.
|
||||
( '$composed_built_in'(NG) ->
|
||||
OUT = depth_bound_call(NG,D)
|
||||
;
|
||||
OUT = ('$set_depth_limit_for_next_call'(D),NG)
|
||||
).
|
||||
'$do_c_built_in'(once(G), M, (yap_hacks:current_choice_point(CP),NG,'$$cut_by'(CP)), MT) :- !,
|
||||
'$do_c_built_in'(G,M,NG0, MT),
|
||||
'$do_c_built_in'(once(G), M, (yap_hacks:current_choice_point(CP),NG,'$$cut_by'(CP))) :- !,
|
||||
'$do_c_built_in'(G,M,NG0),
|
||||
'$clean_cuts'(NG0, NG).
|
||||
'$do_c_built_in'(if(G,A,B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB), MT) :- !,
|
||||
'$do_c_built_in'(A,M,NA0, MT),
|
||||
'$do_c_built_in'(if(G,A,B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
|
||||
'$do_c_built_in'(A,M,NA0),
|
||||
'$clean_cuts'(NA0, NA),
|
||||
'$do_c_built_in'(B,M,NB, MT).
|
||||
'$do_c_built_in'((G*->A), M, (NG,NA), MT) :- !,
|
||||
'$do_c_built_in'(G,M,NG0, MT),
|
||||
'$do_c_built_in'(B,M,NB).
|
||||
'$do_c_built_in'((G*->A), M, (NG,NA)) :- !,
|
||||
'$do_c_built_in'(G,M,NG0),
|
||||
'$clean_cuts'(NG0, NG),
|
||||
'$do_c_built_in'(A,M,NA, MT).
|
||||
'$do_c_built_in'('C'(A,B.C), _, (A=[B|C]), _) :- !.
|
||||
'$do_c_built_in'(X is Y, _, P, _) :-
|
||||
'$do_c_built_in'(A,M,NA).
|
||||
'$do_c_built_in'('C'(A,B.C), _, (A=[B|C])) :- !.
|
||||
'$do_c_built_in'(X is Y, _, P) :-
|
||||
nonvar(Y), % Don't rewrite variables
|
||||
!,
|
||||
(
|
||||
@ -84,7 +80,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
'$drop_is'(X0, X, P1),
|
||||
'$do_and'(P0, P1, P)
|
||||
).
|
||||
'$do_c_built_in'(Comp0, _, R), _ :- % now, do it for comparisons
|
||||
'$do_c_built_in'(Comp0, _, R) :- % now, do it for comparisons
|
||||
'$compop'(Comp0, Op, E, F),
|
||||
!,
|
||||
'$compop'(Comp, Op, U, V),
|
||||
@ -92,7 +88,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
||||
'$expand_expr'(F, Q, V),
|
||||
'$do_and'(P, Q, R0),
|
||||
'$do_and'(R0, Comp, R).
|
||||
'$do_c_built_in'(P, _, P, _).
|
||||
'$do_c_built_in'(P, _, P).
|
||||
|
||||
'$do_c_built_metacall'(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-
|
||||
var(Mod), !.
|
||||
|
||||
@ -870,7 +870,13 @@ not(G) :- \+ '$execute'(G).
|
||||
true
|
||||
;
|
||||
'$enter_undefp',
|
||||
(
|
||||
swi:swi_predicate_table(M,G,NM,Goal)
|
||||
->
|
||||
'$exit_undefp'
|
||||
;
|
||||
once('$find_undefp_handler'(G,M,Goal,NM))
|
||||
)
|
||||
),
|
||||
!,
|
||||
'$execute0'(Goal,NM).
|
||||
|
||||
149
pl/modules.yap
149
pl/modules.yap
@ -90,8 +90,8 @@ module(N) :-
|
||||
'$process_exports'([],_,[]).
|
||||
'$process_exports'([Name/Arity|Exports],Mod,[Name/Arity|ExportedPreds]):- !,
|
||||
'$process_exports'(Exports,Mod,ExportedPreds).
|
||||
'$process_exports'([op(_Prio,_Assoc,_Name)|Exports],Mod,ExportedPreds) :- !,
|
||||
% '$opdec'(_Prio,_Assoc,_Name,Mod),
|
||||
'$process_exports'([op(Prio,Assoc,Name)|Exports],Mod,ExportedPreds) :- !,
|
||||
op(Prio,Assoc,Name),
|
||||
'$process_exports'(Exports,Mod,ExportedPreds).
|
||||
'$process_exports'([Trash|_],Mod,_) :-
|
||||
'$do_error'(type_error(predicate_indicator,Trash),module(Mod,[Trash])).
|
||||
@ -168,7 +168,7 @@ module(N) :-
|
||||
get0(C), '$skipeol'(C),
|
||||
( C is "y" -> erase(R), !;
|
||||
C is "n" -> !, fail;
|
||||
write(user_error, ' Please answer with ''y'' or ''n'' '), fail
|
||||
format(user_error, ' Please answer with ''y'' or ''n'' ',[]), fail
|
||||
).
|
||||
'$check_import'(_,_,_,_).
|
||||
|
||||
@ -181,38 +181,37 @@ module(N) :-
|
||||
|
||||
|
||||
% expand module names in a clause
|
||||
'$module_expansion'(((Mod:H) :-B ),((Mod:H) :- B1),((Mod:H) :- BO),M) :- !,
|
||||
'$is_mt'(Mod,H,MT),
|
||||
'$prepare_body_with_correct_modules'(B, M, MT, B0),
|
||||
'$module_expansion'(((Mod:H) :- B ),((Mod:H) :- B1),((Mod:H) :- BO),M) :- !,
|
||||
'$is_mt'(Mod,H,B,IB,MM),
|
||||
'$prepare_body_with_correct_modules'(IB, M, B0),
|
||||
'$module_u_vars'(H,UVars,M), % collect head variables in
|
||||
% expanded positions
|
||||
'$module_expansion'(B0,B1,BO,M,M,M,UVars,MT). % expand body
|
||||
'$module_expansion'(B0,B1,BO,M,MM,M,UVars). % expand body
|
||||
'$module_expansion'((H:-B),(H:-B1),(H:-BO),M) :-
|
||||
'$is_mt'(Mod,H,MT),
|
||||
'$is_mt'(M,H,B,IB,MM),
|
||||
'$module_u_vars'(H,UVars,M), % collect head variables in
|
||||
% expanded positions
|
||||
'$module_expansion'(B,B1,BO,M,M,M,UVars,MT).% expand body
|
||||
'$module_expansion'(IB,B1,BO,M,MM,M,UVars).
|
||||
% $trace_module((H:-B),(H:-B1)).
|
||||
|
||||
% expand module names in a body
|
||||
'$prepare_body_with_correct_modules'(V,M,MT,call(G)) :- var(V), !,
|
||||
(MT = on -> G = M:V ; G = V).
|
||||
'$prepare_body_with_correct_modules'((A,B),M,MT,(A1,B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,MT,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,MT,B1).
|
||||
'$prepare_body_with_correct_modules'((A;B),M,MT,(A1;B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,MT,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,MT,B1).
|
||||
'$prepare_body_with_correct_modules'((A->B),M,MT,(A1->B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,MT,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,MT,B1).
|
||||
'$prepare_body_with_correct_modules'(true,_,_,true) :- !.
|
||||
'$prepare_body_with_correct_modules'(fail,_,_,fail) :- !.
|
||||
'$prepare_body_with_correct_modules'(false,_,_,false) :- !.
|
||||
'$prepare_body_with_correct_modules'(M:G,_,M:G) :- !.
|
||||
'$prepare_body_with_correct_modules'(G,M,MT,G) :-
|
||||
'$prepare_body_with_correct_modules'(V,M,M:call(V)) :- var(V), !.
|
||||
'$prepare_body_with_correct_modules'((A,B),M,(A1,B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,B1).
|
||||
'$prepare_body_with_correct_modules'((A;B),M,(A1;B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,B1).
|
||||
'$prepare_body_with_correct_modules'((A->B),M,(A1->B1)) :- !,
|
||||
'$prepare_body_with_correct_modules'(A,M,A1),
|
||||
'$prepare_body_with_correct_modules'(B,M,B1).
|
||||
'$prepare_body_with_correct_modules'(true,_,true) :- !.
|
||||
'$prepare_body_with_correct_modules'(fail,_,fail) :- !.
|
||||
'$prepare_body_with_correct_modules'(false,_,false) :- !.
|
||||
'$prepare_body_with_correct_modules'(M:G,M:G) :- !.
|
||||
'$prepare_body_with_correct_modules'(G,M,G) :-
|
||||
'$system_predicate'(G,M), !.
|
||||
'$prepare_body_with_correct_modules'(G,M,MT,M:G).
|
||||
'$prepare_body_with_correct_modules'(G,M,M:G).
|
||||
|
||||
|
||||
'$trace_module'(X) :-
|
||||
@ -242,38 +241,37 @@ module(N) :-
|
||||
% current module for fixing up meta-call arguments
|
||||
% current module for predicate
|
||||
% head variables.
|
||||
'$module_expansion'(V,call(G),call(G),_M,MM,_TM,_,MT) :- var(V), !,
|
||||
(MT = on -> G = V ; G = MM:V).
|
||||
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars,MT) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars,MT),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars,MT).
|
||||
'$module_expansion'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),M,MM,TM,HVars,MT) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,TM,HVars,MT),
|
||||
'$module_expansion'(V,call(G),call(MM:G),_M,MM,_TM,_) :- var(V), !.
|
||||
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,TM,HVars),
|
||||
'$clean_cuts'(AOO, AO),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars,MT),
|
||||
'$module_expansion'(C,C1,CO,M,MM,TM,HVars,MT).
|
||||
'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,TM,HVars,MT) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars,MT),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars,MT).
|
||||
'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,TM,HVars,MT) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars,MT),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars,MT).
|
||||
'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,TM,HVars,MT) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,TM,HVars,MT),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars),
|
||||
'$module_expansion'(C,C1,CO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AOO,M,MM,TM,HVars),
|
||||
'$clean_cuts'(AOO, AO),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars,MT).
|
||||
'$module_expansion'(\+A,\+A1,\+AO,M,MM,TM,HVars,MT) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars,MT).
|
||||
'$module_expansion'(not(A),not(A1),not(AO),M,MM,TM,HVars,MT) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars,MT).
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'(\+A,\+A1,\+AO,M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars).
|
||||
'$module_expansion'(not(A),not(A1),not(AO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars).
|
||||
'$module_expansion'(true,true,true,_,_,_,_) :- !.
|
||||
'$module_expansion'(fail,fail,fail,_,_,_,_) :- !.
|
||||
'$module_expansion'(false,false,false,_,_,_,_) :- !.
|
||||
% if I don't know what the module is, I cannot do anything to the goal,
|
||||
% so I just put a call for later on.
|
||||
'$module_expansion'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_,_) :- var(M), !.
|
||||
'$module_expansion'(M:G,G1,GO,_,_,TM,HVars,MT) :-
|
||||
'$module_expansion'(G,G1,GO,M,M,TM,HVars,MT).
|
||||
'$module_expansion'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !.
|
||||
'$module_expansion'(M:G,G1,GO,_,_,TM,HVars) :-
|
||||
'$module_expansion'(G,G1,GO,M,M,TM,HVars).
|
||||
% if M1 is given explicitly process G within M1's context.
|
||||
% '$module_expansion'(M:G,G1,GO,_Mod,_MM,TM,HVars) :- !,
|
||||
% % is this imported from some other module M1?
|
||||
@ -291,26 +289,37 @@ module(N) :-
|
||||
%
|
||||
% next, check if this is something imported.
|
||||
%
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars,MT) :-
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars) :-
|
||||
% is this imported from some other module M1?
|
||||
( '$imported_pred'(G, CurMod, GG, M1) ->
|
||||
'$module_expansion'(GG, G1, GO, M1, MM, TM, HVars,MT)
|
||||
'$module_expansion'(GG, G1, GO, M1, MM, TM, HVars)
|
||||
;
|
||||
(
|
||||
% only expand meta-predicates if we are not module transparent!
|
||||
MT = off,
|
||||
'$meta_expansion'(CurMod, MM, G, GI, HVars)
|
||||
->
|
||||
true
|
||||
;
|
||||
GI = G
|
||||
),
|
||||
'$complete_goal_expansion'(GI, CurMod, MM, TM, G1, GO, HVars, MT)
|
||||
'$complete_goal_expansion'(GI, CurMod, MM, TM, G1, GO, HVars)
|
||||
).
|
||||
|
||||
|
||||
% be careful here not to generate an undefined exception.
|
||||
'$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
|
||||
'$enter_undefp',
|
||||
'$undefined'(G, ImportingMod),
|
||||
recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_),
|
||||
ExportingMod \= ImportingMod.
|
||||
ExportingMod \= ImportingMod, !,
|
||||
'$exit_undefp'.
|
||||
'$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
|
||||
'$undefined'(G, ImportingMod),
|
||||
swi:swi_predicate_table(ImportingMod,G,ExportingMod,G0),
|
||||
ExportingMod \= ImportingMod,
|
||||
'$exit_undefp'.
|
||||
'$imported_pred'(G, ImportingMod, _, _) :-
|
||||
'$exit_undefp',
|
||||
fail.
|
||||
|
||||
% args are:
|
||||
% goal to expand
|
||||
@ -319,15 +328,15 @@ module(N) :-
|
||||
% goal to pass to compiler
|
||||
% goal to pass to listing
|
||||
% head variables.
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars, MT) :-
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :-
|
||||
'$pred_goal_expansion_on',
|
||||
user:goal_expansion(G,M,GI), !,
|
||||
'$module_expansion'(GI, G1, G2, M, CM, TM, HVars, MT).
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars, MT) :-
|
||||
'$module_expansion'(GI, G1, G2, M, CM, TM, HVars).
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :-
|
||||
'$all_system_predicate'(G,M), !,
|
||||
'$c_built_in'(G, M, Gi, MT),
|
||||
'$c_built_in'(G, M, Gi),
|
||||
(Gi \== G ->
|
||||
'$module_expansion'(Gi, _, G2, M, CM, TM, HVars, MT),
|
||||
'$module_expansion'(Gi, _, G2, M, CM, TM, HVars),
|
||||
% make built-in processing transparent.
|
||||
(TM = M -> G1 = G ; G1 = M:G)
|
||||
; TM = M ->
|
||||
@ -335,8 +344,8 @@ module(N) :-
|
||||
;
|
||||
G2 = M:G, G1 = M:G % atts:
|
||||
).
|
||||
'$complete_goal_expansion'(G, Mod, _, Mod, G, G, _, _) :- !.
|
||||
'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _, _).
|
||||
'$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !.
|
||||
'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).
|
||||
|
||||
|
||||
% module_transparent declaration
|
||||
@ -349,14 +358,18 @@ module(N) :-
|
||||
'$module_transparent'(Ps, M).
|
||||
'$module_transparent'(M:D, _) :- !,
|
||||
'$module_transparent'(D, M).
|
||||
'$module_transparent'(F/N, M) :-
|
||||
'$module_transparent'(F,M,N,_), !.
|
||||
'$module_transparent'(F/N, M) :-
|
||||
functor(P,F,N),
|
||||
( retractall('$module_transparent'(F,M,N,_)), fail ; true),
|
||||
asserta(prolog:'$module_transparent'(F,M,N,P)).
|
||||
asserta(prolog:'$module_transparent'(F,M,N,P)),
|
||||
'$flags'(P, M, Fl, Fl),
|
||||
NFlags is Fl \/ 0x200004,
|
||||
'$flags'(P, M, Fl, NFlags).
|
||||
|
||||
'$is_mt'(Mod,H,on) :-
|
||||
'$is_mt'(M,H0,B,(context_module(CM),B),CM) :-
|
||||
'$module_transparent'(_,M,_,H), !.
|
||||
'$is_mt'(_,_,off).
|
||||
'$is_mt'(M,_,B,B,M).
|
||||
|
||||
% meta_predicate declaration
|
||||
% records $meta_predicate(SourceModule,Functor,Arity,Declaration)
|
||||
|
||||
Reference in New Issue
Block a user