stop using submodule
This commit is contained in:
Vítor Santos Costa
281
packages/chr/Examples/bool.chr
Normal file
281
packages/chr/Examples/bool.chr
Normal file
@@ -0,0 +1,281 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% Thom Fruehwirth ECRC 1991-1993
|
||||
%% 910528 started boolean,and,or constraints
|
||||
%% 910904 added xor,neg constraints
|
||||
%% 911120 added imp constraint
|
||||
%% 931110 ported to new release
|
||||
%% 931111 added card constraint
|
||||
%% 961107 Christian Holzbaur, SICStus mods
|
||||
%%
|
||||
%% ported to hProlog by Tom Schrijvers June 2003
|
||||
|
||||
|
||||
:- module(bool,[]).
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints boolean/1, and/3, or/3, xor/3, neg/2, imp/2, labeling/0, card/4.
|
||||
|
||||
|
||||
boolean(0) <=> true.
|
||||
boolean(1) <=> true.
|
||||
|
||||
labeling, boolean(A)#Pc <=>
|
||||
( A=0 ; A=1),
|
||||
labeling
|
||||
pragma passive(Pc).
|
||||
|
||||
|
||||
%% and/3 specification
|
||||
%%and(0,0,0).
|
||||
%%and(0,1,0).
|
||||
%%and(1,0,0).
|
||||
%%and(1,1,1).
|
||||
|
||||
and(0,X,Y) <=> Y=0.
|
||||
and(X,0,Y) <=> Y=0.
|
||||
and(1,X,Y) <=> Y=X.
|
||||
and(X,1,Y) <=> Y=X.
|
||||
and(X,Y,1) <=> X=1,Y=1.
|
||||
and(X,X,Z) <=> X=Z.
|
||||
%%and(X,Y,X) <=> imp(X,Y).
|
||||
%%and(X,Y,Y) <=> imp(Y,X).
|
||||
and(X,Y,A) \ and(X,Y,B) <=> A=B.
|
||||
and(X,Y,A) \ and(Y,X,B) <=> A=B.
|
||||
|
||||
labeling, and(A,B,C)#Pc <=>
|
||||
label_and(A,B,C),
|
||||
labeling
|
||||
pragma passive(Pc).
|
||||
|
||||
label_and(0,X,0).
|
||||
label_and(1,X,X).
|
||||
|
||||
|
||||
%% or/3 specification
|
||||
%%or(0,0,0).
|
||||
%%or(0,1,1).
|
||||
%%or(1,0,1).
|
||||
%%or(1,1,1).
|
||||
|
||||
or(0,X,Y) <=> Y=X.
|
||||
or(X,0,Y) <=> Y=X.
|
||||
or(X,Y,0) <=> X=0,Y=0.
|
||||
or(1,X,Y) <=> Y=1.
|
||||
or(X,1,Y) <=> Y=1.
|
||||
or(X,X,Z) <=> X=Z.
|
||||
%%or(X,Y,X) <=> imp(Y,X).
|
||||
%%or(X,Y,Y) <=> imp(X,Y).
|
||||
or(X,Y,A) \ or(X,Y,B) <=> A=B.
|
||||
or(X,Y,A) \ or(Y,X,B) <=> A=B.
|
||||
|
||||
labeling, or(A,B,C)#Pc <=>
|
||||
label_or(A,B,C),
|
||||
labeling
|
||||
pragma passive(Pc).
|
||||
|
||||
label_or(0,X,X).
|
||||
label_or(1,X,1).
|
||||
|
||||
|
||||
%% xor/3 specification
|
||||
%%xor(0,0,0).
|
||||
%%xor(0,1,1).
|
||||
%%xor(1,0,1).
|
||||
%%xor(1,1,0).
|
||||
|
||||
xor(0,X,Y) <=> X=Y.
|
||||
xor(X,0,Y) <=> X=Y.
|
||||
xor(X,Y,0) <=> X=Y.
|
||||
xor(1,X,Y) <=> neg(X,Y).
|
||||
xor(X,1,Y) <=> neg(X,Y).
|
||||
xor(X,Y,1) <=> neg(X,Y).
|
||||
xor(X,X,Y) <=> Y=0.
|
||||
xor(X,Y,X) <=> Y=0.
|
||||
xor(Y,X,X) <=> Y=0.
|
||||
xor(X,Y,A) \ xor(X,Y,B) <=> A=B.
|
||||
xor(X,Y,A) \ xor(Y,X,B) <=> A=B.
|
||||
|
||||
labeling, xor(A,B,C)#Pc <=>
|
||||
label_xor(A,B,C),
|
||||
labeling
|
||||
pragma passive(Pc).
|
||||
|
||||
label_xor(0,X,X).
|
||||
label_xor(1,X,Y):- neg(X,Y).
|
||||
|
||||
|
||||
%% neg/2 specification
|
||||
%%neg(0,1).
|
||||
%%neg(1,0).
|
||||
|
||||
neg(0,X) <=> X=1.
|
||||
neg(X,0) <=> X=1.
|
||||
neg(1,X) <=> X=0.
|
||||
neg(X,1) <=> X=0.
|
||||
neg(X,X) <=> fail.
|
||||
neg(X,Y) \ neg(Y,Z) <=> X=Z.
|
||||
neg(X,Y) \ neg(Z,Y) <=> X=Z.
|
||||
neg(Y,X) \ neg(Y,Z) <=> X=Z.
|
||||
%% Interaction with other boolean constraints
|
||||
neg(X,Y) \ and(X,Y,Z) <=> Z=0.
|
||||
neg(Y,X) \ and(X,Y,Z) <=> Z=0.
|
||||
neg(X,Z) , and(X,Y,Z) <=> X=1,Y=0,Z=0.
|
||||
neg(Z,X) , and(X,Y,Z) <=> X=1,Y=0,Z=0.
|
||||
neg(Y,Z) , and(X,Y,Z) <=> X=0,Y=1,Z=0.
|
||||
neg(Z,Y) , and(X,Y,Z) <=> X=0,Y=1,Z=0.
|
||||
neg(X,Y) \ or(X,Y,Z) <=> Z=1.
|
||||
neg(Y,X) \ or(X,Y,Z) <=> Z=1.
|
||||
neg(X,Z) , or(X,Y,Z) <=> X=0,Y=1,Z=1.
|
||||
neg(Z,X) , or(X,Y,Z) <=> X=0,Y=1,Z=1.
|
||||
neg(Y,Z) , or(X,Y,Z) <=> X=1,Y=0,Z=1.
|
||||
neg(Z,Y) , or(X,Y,Z) <=> X=1,Y=0,Z=1.
|
||||
neg(X,Y) \ xor(X,Y,Z) <=> Z=1.
|
||||
neg(Y,X) \ xor(X,Y,Z) <=> Z=1.
|
||||
neg(X,Z) \ xor(X,Y,Z) <=> Y=1.
|
||||
neg(Z,X) \ xor(X,Y,Z) <=> Y=1.
|
||||
neg(Y,Z) \ xor(X,Y,Z) <=> X=1.
|
||||
neg(Z,Y) \ xor(X,Y,Z) <=> X=1.
|
||||
neg(X,Y) , imp(X,Y) <=> X=0,Y=1.
|
||||
neg(Y,X) , imp(X,Y) <=> X=0,Y=1.
|
||||
|
||||
labeling, neg(A,B)#Pc <=>
|
||||
label_neg(A,B),
|
||||
labeling
|
||||
pragma passive(Pc).
|
||||
|
||||
label_neg(0,1).
|
||||
label_neg(1,0).
|
||||
|
||||
|
||||
%% imp/2 specification (implication)
|
||||
%%imp(0,0).
|
||||
%%imp(0,1).
|
||||
%%imp(1,1).
|
||||
|
||||
imp(0,X) <=> true.
|
||||
imp(X,0) <=> X=0.
|
||||
imp(1,X) <=> X=1.
|
||||
imp(X,1) <=> true.
|
||||
imp(X,X) <=> true.
|
||||
imp(X,Y),imp(Y,X) <=> X=Y.
|
||||
|
||||
labeling, imp(A,B)#Pc <=>
|
||||
label_imp(A,B),
|
||||
labeling
|
||||
pragma passive(Pc).
|
||||
|
||||
label_imp(0,X).
|
||||
label_imp(1,1).
|
||||
|
||||
|
||||
|
||||
%% Boolean cardinality operator
|
||||
%% card(A,B,L,N) constrains list L of length N to have between A and B 1s
|
||||
|
||||
|
||||
card(A,B,L):-
|
||||
length(L,N),
|
||||
A=<B,0=<B,A=<N, %0=<N
|
||||
card(A,B,L,N).
|
||||
|
||||
%% card/4 specification
|
||||
%%card(A,B,[],0):- A=<0,0=<B.
|
||||
%%card(A,B,[0|L],N):-
|
||||
%% N1 is N-1,
|
||||
%% card(A,B,L,N1).
|
||||
%%card(A,B,[1|L],N):-
|
||||
%% A1 is A-1, B1 is B-1, N1 is N-1,
|
||||
%% card(A1,B1,L,N1).
|
||||
|
||||
triv_sat @ card(A,B,L,N) <=> A=<0,N=<B | true. % trivial satisfaction
|
||||
pos_sat @ card(N,B,L,N) <=> set_to_ones(L). % positive satisfaction
|
||||
neg_sat @ card(A,0,L,N) <=> set_to_zeros(L). % negative satisfaction
|
||||
pos_red @ card(A,B,L,N) <=> b_delete(X,L,L1),X==1 | % positive reduction
|
||||
A1 is A-1, B1 is B-1, N1 is N-1,
|
||||
card(A1,B1,L1,N1).
|
||||
neg_red @ card(A,B,L,N) <=> b_delete(X,L,L1),X==0 | % negative reduction
|
||||
N1 is N-1,
|
||||
card(A,B,L1,N1).
|
||||
%% special cases with two variables
|
||||
card2nand @ card(0,1,[X,Y],2) <=> and(X,Y,0).
|
||||
card2neg @ card(1,1,[X,Y],2) <=> neg(X,Y).
|
||||
card2or @ card(1,2,[X,Y],2) <=> or(X,Y,1).
|
||||
|
||||
b_delete( X, [X|L], L).
|
||||
b_delete( Y, [X|Xs], [X|Xt]) :-
|
||||
b_delete( Y, Xs, Xt).
|
||||
|
||||
labeling, card(A,B,L,N)#Pc <=>
|
||||
label_card(A,B,L,N),
|
||||
labeling
|
||||
pragma passive(Pc).
|
||||
|
||||
label_card(A,B,[],0):- A=<0,0=<B.
|
||||
label_card(A,B,[0|L],N):-
|
||||
N1 is N-1,
|
||||
card(A,B,L).
|
||||
label_card(A,B,[1|L],N):-
|
||||
A1 is A-1, B1 is B-1, N1 is N-1,
|
||||
card(A1,B1,L).
|
||||
|
||||
set_to_ones([]).
|
||||
set_to_ones([1|L]):-
|
||||
set_to_ones(L).
|
||||
|
||||
set_to_zeros([]).
|
||||
set_to_zeros([0|L]):-
|
||||
set_to_zeros(L).
|
||||
|
||||
|
||||
|
||||
%% Auxiliary predicates
|
||||
|
||||
:- op(100,xfy,#).
|
||||
|
||||
solve_bool(A,C) :- var(A), !, A=C.
|
||||
solve_bool(A,C) :- atomic(A), !, A=C.
|
||||
solve_bool(A * B, C) :- !,
|
||||
solve_bool(A,A1),
|
||||
solve_bool(B,B1),
|
||||
and(A1,B1,C).
|
||||
solve_bool(A + B, C) :- !,
|
||||
solve_bool(A,A1),
|
||||
solve_bool(B,B1),
|
||||
or(A1,B1,C).
|
||||
solve_bool(A # B, C) :- !,
|
||||
solve_bool(A,A1),
|
||||
solve_bool(B,B1),
|
||||
xor(A1,B1,C).
|
||||
solve_bool(not(A),C) :- !,
|
||||
solve_bool(A,A1),
|
||||
neg(A1,C).
|
||||
solve_bool((A -> B), C) :- !,
|
||||
solve_bool(A,A1),
|
||||
solve_bool(B,B1),
|
||||
imp(A1,B1),C=1.
|
||||
solve_bool(A = B, C) :- !,
|
||||
solve_bool(A,A1),
|
||||
solve_bool(B,B1),
|
||||
A1=B1,C=1.
|
||||
|
||||
%% Labeling
|
||||
label_bool([]).
|
||||
label_bool([X|L]) :-
|
||||
( X=0;X=1),
|
||||
label_bool(L).
|
||||
|
||||
/* % no write macros in SICStus and hProlog
|
||||
|
||||
bool_portray(and(A,B,C),Out):- !, Out = (A*B = C).
|
||||
bool_portray(or(A,B,C),Out):- !, Out = (A+B = C).
|
||||
bool_portray(xor(A,B,C),Out):- !, Out = (A#B = C).
|
||||
bool_portray(neg(A,B),Out):- !, Out = (A= not(B)).
|
||||
bool_portray(imp(A,B),Out):- !, Out = (A -> B).
|
||||
bool_portray(card(A,B,L,N),Out):- !, Out = card(A,B,L).
|
||||
|
||||
:- define_macro(type(compound),bool_portray/2,[write]).
|
||||
*/
|
||||
|
||||
/* end of handler bool */
|
||||
|
||||
84
packages/chr/Examples/chrdif.chr
Normal file
84
packages/chr/Examples/chrdif.chr
Normal file
@@ -0,0 +1,84 @@
|
||||
/* $Id$
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
Author: Tom Schrijvers
|
||||
E-mail: Tom.Schrijvers@cs.kuleuven.be
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 2003-2004, K.U. Leuven
|
||||
|
||||
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 Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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(chrdif,[chrdif/2]).
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints dif/2, dif2/3, or/2, or_seq/2, del_or/1.
|
||||
|
||||
chrdif(X,Y) :- dif(X,Y).
|
||||
|
||||
dif(X,Y) <=> compound(X), compound(Y) | dif1(X,Y).
|
||||
dif(X,X) <=> fail.
|
||||
dif(X,Y) <=> nonvar(X), nonvar(Y) /* X \== Y holds */ | true.
|
||||
|
||||
dif1(X,Y) :-
|
||||
( functor(X,F,A),
|
||||
functor(Y,F,A) ->
|
||||
X =.. [_|XL],
|
||||
Y =.. [_|YL],
|
||||
dif1l(XL,YL,A)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
dif1l(Xs,Ys,N) :-
|
||||
or(Or,N),
|
||||
dif1l_2(Xs,Ys,Or).
|
||||
|
||||
dif1l_2([],[],_).
|
||||
dif1l_2([X|Xs],[Y|Ys],Or) :-
|
||||
dif2(X,Y,Or),
|
||||
dif1l_2(Xs,Ys,Or).
|
||||
|
||||
or_seq(OrP,Or) \ or(Or,0), or(OrP,N) <=> M is N - 1, or_seq(OrP,M).
|
||||
or(_,0) <=> fail.
|
||||
|
||||
dif2(X,Y,Or) <=> compound(X), compound(Y) | dif3(X,Y,Or).
|
||||
dif2(X,X,Or), or(Or,N) <=> M is N - 1, or(Or,M).
|
||||
dif2(X,Y,Or) <=> nonvar(X), nonvar(Y) /* X \== Y holds */ | del_or(Or).
|
||||
|
||||
del_or(Or) \ or_seq(OrP,Or) <=> del_or(OrP).
|
||||
del_or(Or) \ or_seq(Or,OrC) <=> del_or(OrC).
|
||||
del_or(Or) \ or(Or,_) <=> true.
|
||||
del_or(Or) \ dif2(_,_,Or) <=> true.
|
||||
del_or(Or) <=> true.
|
||||
|
||||
dif3(X,Y,Or) :-
|
||||
( functor(X,F,A),
|
||||
functor(Y,F,A) ->
|
||||
X =.. [_|XL],
|
||||
Y =.. [_|YL],
|
||||
or_seq(Or,Or2),
|
||||
dif1l(XL,YL,A)
|
||||
;
|
||||
del_or(Or)
|
||||
).
|
||||
6
packages/chr/Examples/chrfreeze.chr
Normal file
6
packages/chr/Examples/chrfreeze.chr
Normal file
@@ -0,0 +1,6 @@
|
||||
:- module(chrfreeze,[chrfreeze/2]).
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints chrfreeze/2.
|
||||
|
||||
chrfreeze(V,G) <=> nonvar(V) | call(G).
|
||||
197
packages/chr/Examples/deadcode.pl
Normal file
197
packages/chr/Examples/deadcode.pl
Normal file
@@ -0,0 +1,197 @@
|
||||
/* $Id$
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
Author: Tom Schrijvers
|
||||
E-mail: Tom.Schrijvers@cs.kuleuven.be
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 2003-2004, K.U. Leuven
|
||||
|
||||
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 Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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(deadcode,[deadcode/2]).
|
||||
|
||||
:- use_module(library(chr)).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
:- constraints
|
||||
defined_predicate(+any),
|
||||
calls(+any,+any),
|
||||
live(+any),
|
||||
print_dead_predicates.
|
||||
|
||||
defined_predicate(P) \ defined_predicate(P) <=> true.
|
||||
|
||||
calls(P,Q) \ calls(P,Q) <=> true.
|
||||
|
||||
live(P) \ live(P) <=> true.
|
||||
|
||||
live(P), calls(P,Q) ==> live(Q).
|
||||
|
||||
print_dead_predicates \ live(P), defined_predicate(P) <=> true.
|
||||
print_dead_predicates \ defined_predicate(P) <=>
|
||||
writeln(P).
|
||||
print_dead_predicates \ calls(_,_) <=> true.
|
||||
print_dead_predicates \ live(_) <=> true.
|
||||
print_dead_predicates <=> true.
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
deadcode(File,Starts) :-
|
||||
readfile(File,Clauses),
|
||||
exported_predicates(Clauses,Exports),
|
||||
findall(C, ( member(C,Clauses), C \= (:- _) , C \= (?- _)), Cs),
|
||||
process_clauses(Cs),
|
||||
append(Starts,Exports,Alive),
|
||||
live_predicates(Alive),
|
||||
print_dead_predicates.
|
||||
|
||||
exported_predicates(Clauses,Exports) :-
|
||||
( member( (:- module(_, Exports)), Clauses) ->
|
||||
true
|
||||
;
|
||||
Exports = []
|
||||
).
|
||||
process_clauses([]).
|
||||
process_clauses([C|Cs]) :-
|
||||
hb(C,H,B),
|
||||
extract_predicates(B,Ps,[]),
|
||||
functor(H,F,A),
|
||||
defined_predicate(F/A),
|
||||
calls_predicates(Ps,F/A),
|
||||
process_clauses(Cs).
|
||||
|
||||
calls_predicates([],FA).
|
||||
calls_predicates([P|Ps],FA) :-
|
||||
calls(FA,P),
|
||||
calls_predicates(Ps,FA).
|
||||
|
||||
hb(C,H,B) :-
|
||||
( C = (H :- B) ->
|
||||
true
|
||||
;
|
||||
C = H,
|
||||
B = true
|
||||
).
|
||||
|
||||
live_predicates([]).
|
||||
live_predicates([P|Ps]) :-
|
||||
live(P),
|
||||
live_predicates(Ps).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
extract_predicates(!,L,L) :- ! .
|
||||
extract_predicates(_ < _,L,L) :- ! .
|
||||
extract_predicates(_ = _,L,L) :- ! .
|
||||
extract_predicates(_ =.. _ ,L,L) :- ! .
|
||||
extract_predicates(_ =:= _,L,L) :- ! .
|
||||
extract_predicates(_ == _,L,L) :- ! .
|
||||
extract_predicates(_ > _,L,L) :- ! .
|
||||
extract_predicates(_ \= _,L,L) :- ! .
|
||||
extract_predicates(_ \== _,L,L) :- ! .
|
||||
extract_predicates(_ is _,L,L) :- ! .
|
||||
extract_predicates(arg(_,_,_),L,L) :- ! .
|
||||
extract_predicates(atom_concat(_,_,_),L,L) :- ! .
|
||||
extract_predicates(atomic(_),L,L) :- ! .
|
||||
extract_predicates(b_getval(_,_),L,L) :- ! .
|
||||
extract_predicates(call(_),L,L) :- ! .
|
||||
extract_predicates(compound(_),L,L) :- ! .
|
||||
extract_predicates(copy_term(_,_),L,L) :- ! .
|
||||
extract_predicates(del_attr(_,_),L,L) :- ! .
|
||||
extract_predicates(fail,L,L) :- ! .
|
||||
extract_predicates(functor(_,_,_),L,L) :- ! .
|
||||
extract_predicates(get_attr(_,_,_),L,L) :- ! .
|
||||
extract_predicates(length(_,_),L,L) :- ! .
|
||||
extract_predicates(nb_setval(_,_),L,L) :- ! .
|
||||
extract_predicates(nl,L,L) :- ! .
|
||||
extract_predicates(nonvar(_),L,L) :- ! .
|
||||
extract_predicates(once(G),L,T) :- !,
|
||||
( nonvar(G) ->
|
||||
extract_predicates(G,L,T)
|
||||
;
|
||||
L = T
|
||||
).
|
||||
extract_predicates(op(_,_,_),L,L) :- ! .
|
||||
extract_predicates(prolog_flag(_,_),L,L) :- ! .
|
||||
extract_predicates(prolog_flag(_,_,_),L,L) :- ! .
|
||||
extract_predicates(put_attr(_,_,_),L,L) :- ! .
|
||||
extract_predicates(read(_),L,L) :- ! .
|
||||
extract_predicates(see(_),L,L) :- ! .
|
||||
extract_predicates(seen,L,L) :- ! .
|
||||
extract_predicates(setarg(_,_,_),L,L) :- ! .
|
||||
extract_predicates(tell(_),L,L) :- ! .
|
||||
extract_predicates(term_variables(_,_),L,L) :- ! .
|
||||
extract_predicates(told,L,L) :- ! .
|
||||
extract_predicates(true,L,L) :- ! .
|
||||
extract_predicates(var(_),L,L) :- ! .
|
||||
extract_predicates(write(_),L,L) :- ! .
|
||||
extract_predicates((G1,G2),L,T) :- ! ,
|
||||
extract_predicates(G1,L,T1),
|
||||
extract_predicates(G2,T1,T).
|
||||
extract_predicates((G1->G2),L,T) :- !,
|
||||
extract_predicates(G1,L,T1),
|
||||
extract_predicates(G2,T1,T).
|
||||
extract_predicates((G1;G2),L,T) :- !,
|
||||
extract_predicates(G1,L,T1),
|
||||
extract_predicates(G2,T1,T).
|
||||
extract_predicates(\+ G, L, T) :- !,
|
||||
extract_predicates(G, L, T).
|
||||
extract_predicates(findall(_,G,_),L,T) :- !,
|
||||
extract_predicates(G,L,T).
|
||||
extract_predicates(bagof(_,G,_),L,T) :- !,
|
||||
extract_predicates(G,L,T).
|
||||
extract_predicates(_^G,L,T) :- !,
|
||||
extract_predicates(G,L,T).
|
||||
extract_predicates(_:Call,L,T) :- !,
|
||||
extract_predicates(Call,L,T).
|
||||
extract_predicates(Call,L,T) :-
|
||||
( var(Call) ->
|
||||
L = T
|
||||
;
|
||||
functor(Call,F,A),
|
||||
L = [F/A|T]
|
||||
).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% File Reading
|
||||
|
||||
readfile(File,Declarations) :-
|
||||
see(File),
|
||||
readcontent(Declarations),
|
||||
seen.
|
||||
|
||||
readcontent(C) :-
|
||||
read(X),
|
||||
( X = (:- op(Prec,Fix,Op)) ->
|
||||
op(Prec,Fix,Op)
|
||||
;
|
||||
true
|
||||
),
|
||||
( X == end_of_file ->
|
||||
C = []
|
||||
;
|
||||
C = [X | Xs],
|
||||
readcontent(Xs)
|
||||
).
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
116
packages/chr/Examples/family.chr
Normal file
116
packages/chr/Examples/family.chr
Normal file
@@ -0,0 +1,116 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% 000401 Slim Abdennadher and Henning Christiansen
|
||||
%%
|
||||
%% ported to hProlog by Tom Schrijvers
|
||||
|
||||
:- module(family,[]).
|
||||
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints
|
||||
% extensional predicates:
|
||||
person/2, father/2, mother/2,
|
||||
orphan/1,
|
||||
% intensional predicates:
|
||||
parent/2, sibling/2,
|
||||
% predefined:
|
||||
diff/2,
|
||||
% a little helper:
|
||||
start/0.
|
||||
|
||||
% Representing the test for failed state, i.e.,
|
||||
% that the 'predefined' are satisfiable
|
||||
|
||||
diff(X,X) ==> false.
|
||||
|
||||
|
||||
|
||||
% Definition rules:
|
||||
|
||||
parent_def @
|
||||
parent(P,C) <=> (true | (father(P,C) ; mother(P,C))).
|
||||
|
||||
sibling_def @
|
||||
sibling(C1,C2) <=>
|
||||
diff(C1,C2),
|
||||
parent(P,C1), parent(P,C2).
|
||||
|
||||
ext_intro @
|
||||
start <=> father(john,mary), father(john,peter),
|
||||
mother(jane,mary),
|
||||
person(john,male), person(peter,male),
|
||||
person(jane,female), person(mary,female),
|
||||
person(paul,male).
|
||||
|
||||
|
||||
|
||||
% Closing rules
|
||||
father_close @
|
||||
father(X,Y) ==> ( true | ((X=john, Y=mary) ; (X=john, Y=peter))).
|
||||
|
||||
% mother close @
|
||||
mother(X,Y) ==> X=jane, Y=mary.
|
||||
|
||||
% person_close @
|
||||
person(X,Y) ==> ( true | ( (X=john, Y=male) ;
|
||||
(X=peter, Y=male) ;
|
||||
(X=jane, Y=female) ;
|
||||
(X=mary, Y=female) ;
|
||||
(X=paul, Y=male)
|
||||
)
|
||||
).
|
||||
|
||||
|
||||
|
||||
% ICs
|
||||
|
||||
ic_father_unique @
|
||||
father(F1,C),father(F2,C) ==> F1=F2.
|
||||
|
||||
|
||||
ic_mother_unique @
|
||||
mother(M1,C),mother(M2,C) ==> M1=M2.
|
||||
|
||||
ic_gender_unique @
|
||||
person(P,G1), person(P,G2) ==> G1=G2.
|
||||
|
||||
ic_father_persons @
|
||||
father(F,C) ==> person(F,male), person(C,S).
|
||||
|
||||
ic_mother_persons @
|
||||
mother(M,C) ==> person(M,female), person(C,G).
|
||||
|
||||
% Indirect def.
|
||||
|
||||
orphan1 @
|
||||
orphan(C) ==> person(C,G).
|
||||
|
||||
orphan2 @
|
||||
orphan(C), /* person(F,male),*/ father(F,C) ==> false.
|
||||
|
||||
orphan3 @
|
||||
orphan(C), /* person(M,female),*/ mother(M,C) ==> false.
|
||||
|
||||
|
||||
|
||||
%%%% The following just to simplify output;
|
||||
|
||||
|
||||
father(F,C) \ father(F,C)<=> true.
|
||||
mother(M,C) \ mother(M,C)<=> true.
|
||||
person(M,C) \ person(M,C)<=> true.
|
||||
orphan(C) \ orphan(C)<=> true.
|
||||
|
||||
|
||||
/*************************************************
|
||||
Sample goals
|
||||
|
||||
:- start, sibling(peter,mary).
|
||||
|
||||
:- start, sibling(paul,mary).
|
||||
|
||||
:- father(X,Y), mother(X,Y).
|
||||
|
||||
**************************************************/
|
||||
|
||||
24
packages/chr/Examples/fib.chr
Normal file
24
packages/chr/Examples/fib.chr
Normal file
@@ -0,0 +1,24 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% 991202 Slim Abdennadher, LMU
|
||||
%%
|
||||
%% ported to hProlog by Tom Schrijvers
|
||||
|
||||
:- module(fib,[]).
|
||||
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints fib/2.
|
||||
|
||||
%% fib(N,M) is true if M is the Nth Fibonacci number.
|
||||
|
||||
%% Top-down Evaluation with Tabulation
|
||||
|
||||
fib(N,M1), fib(N,M2) <=> M1 = M2, fib(N,M1).
|
||||
|
||||
fib(0,M) ==> M = 1.
|
||||
|
||||
fib(1,M) ==> M = 1.
|
||||
|
||||
fib(N,M) ==> N > 1 | N1 is N-1, fib(N1,M1), N2 is N-2, fib(N2,M2), M is M1 + M2.
|
||||
|
||||
31
packages/chr/Examples/fibonacci.chr
Normal file
31
packages/chr/Examples/fibonacci.chr
Normal file
@@ -0,0 +1,31 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% 16 June 2003 Bart Demoen, Tom Schrijvers, K.U.Leuven
|
||||
%%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
:- module(fibonacci,[]).
|
||||
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints fibonacci/2.
|
||||
|
||||
%% fibonacci(N,M) is true iff M is the Nth Fibonacci number.
|
||||
|
||||
%% Top-down Evaluation with effective Tabulation
|
||||
%% Contrary to the version in the SICStus manual, this one does "true"
|
||||
%% tabulation
|
||||
|
||||
fibonacci(N,M1) # Id \ fibonacci(N,M2) <=> var(M2) | M1 = M2 pragma passive(Id).
|
||||
|
||||
fibonacci(0,M) ==> M = 1.
|
||||
|
||||
fibonacci(1,M) ==> M = 1.
|
||||
|
||||
fibonacci(N,M) ==>
|
||||
N > 1 |
|
||||
N1 is N-1,
|
||||
fibonacci(N1,M1),
|
||||
N2 is N-2,
|
||||
fibonacci(N2,M2),
|
||||
M is M1 + M2.
|
||||
28
packages/chr/Examples/gcd.chr
Normal file
28
packages/chr/Examples/gcd.chr
Normal file
@@ -0,0 +1,28 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% 980202, 980311 Thom Fruehwirth, LMU
|
||||
%% computes greatest common divisor of positive numbers written each as gcd(N)
|
||||
%%
|
||||
%% ported to hProlog by Tom Schrijvers
|
||||
|
||||
:- module(gcd,[]).
|
||||
|
||||
:- use_module( library(chr)).
|
||||
|
||||
:- constraints gcd/1.
|
||||
|
||||
gcd(0) <=> true.
|
||||
%%gcd(N) \ gcd(M) <=> N=<M | L is M-N, gcd(L).
|
||||
gcd(N) \ gcd(M) <=> N=<M | L is M mod N, gcd(L). % faster variant
|
||||
|
||||
/*
|
||||
%% Sample queries
|
||||
|
||||
gcd(2),gcd(3).
|
||||
|
||||
gcd(1.5),gcd(2.5).
|
||||
|
||||
X is 37*11*11*7*3, Y is 11*7*5*3, Z is 37*11*5,gcd(X),gcd(Y),gcd(Z).
|
||||
|
||||
*/
|
||||
|
||||
34
packages/chr/Examples/leq.chr
Normal file
34
packages/chr/Examples/leq.chr
Normal file
@@ -0,0 +1,34 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% simple constraint solver for inequalities between variables
|
||||
%% thom fruehwirth ECRC 950519, LMU 980207, 980311
|
||||
%%
|
||||
%% ported to hProlog by Tom Schrijvers
|
||||
|
||||
:- module(leq,[]).
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints leq/2.
|
||||
reflexivity @ leq(X,X) <=> true.
|
||||
antisymmetry @ leq(X,Y), leq(Y,X) <=> X = Y.
|
||||
idempotence @ leq(X,Y) \ leq(X,Y) <=> true.
|
||||
transitivity @ leq(X,Y), leq(Y,Z) ==> leq(X,Z).
|
||||
|
||||
t(N):-
|
||||
cputime(X),
|
||||
length(L,N),
|
||||
genleq(L,Last),
|
||||
L=[First|_],
|
||||
leq(Last,First),
|
||||
cputime( Now),
|
||||
Time is Now-X,
|
||||
write(N-Time), nl.
|
||||
|
||||
genleq([Last],Last) :- ! .
|
||||
genleq([X,Y|Xs],Last):-
|
||||
leq(X,Y),
|
||||
genleq([Y|Xs],Last).
|
||||
|
||||
cputime( Ts) :-
|
||||
statistics( runtime, [Tm,_]),
|
||||
Ts is Tm/1000.
|
||||
138
packages/chr/Examples/listdom.chr
Normal file
138
packages/chr/Examples/listdom.chr
Normal file
@@ -0,0 +1,138 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% Slim Abdennadher, Thom Fruehwirth, LMU, July 1998
|
||||
%% Finite (enumeration, list) domain solver over integers
|
||||
%%
|
||||
%% * ported to hProlog by Tom Schrijvers, K.U.Leuven
|
||||
|
||||
% :- module(listdom,[]).
|
||||
|
||||
:- use_module( library(chr)).
|
||||
|
||||
:- use_module( library(lists)).
|
||||
|
||||
|
||||
%% for domain constraints
|
||||
:- op( 700,xfx,'::').
|
||||
:- op( 600,xfx,'..').
|
||||
|
||||
%% for inequality constraints
|
||||
:- op( 700,xfx,lt).
|
||||
:- op( 700,xfx,le).
|
||||
:- op( 700,xfx,ne).
|
||||
|
||||
%% for domain constraints
|
||||
?- op( 700,xfx,'::').
|
||||
?- op( 600,xfx,'..').
|
||||
|
||||
%% for inequality constraints
|
||||
?- op( 700,xfx,lt).
|
||||
?- op( 700,xfx,le).
|
||||
?- op( 700,xfx,ne).
|
||||
|
||||
:- constraints (::)/2, (le)/2, (lt)/2, (ne)/2, add/3, mult/3.
|
||||
%% X::Dom - X must be element of the finite list domain Dom
|
||||
|
||||
%% special cases
|
||||
X::[] <=> fail.
|
||||
%%X::[Y] <=> X=Y.
|
||||
%%X::[A|L] <=> ground(X) | (member(X,[A|L]) -> true).
|
||||
|
||||
%% intersection of domains for the same variable
|
||||
X::L1, X::L2 <=> is_list(L1), is_list(L2) |
|
||||
intersection(L1,L2,L) , X::L.
|
||||
|
||||
X::L, X::Min..Max <=> is_list(L) |
|
||||
remove_lower(Min,L,L1), remove_higher(Max,L1,L2),
|
||||
X::L2.
|
||||
|
||||
|
||||
%% interaction with inequalities
|
||||
|
||||
X le Y, X::L1, Y::L2 ==> is_list(L1),is_list(L2),
|
||||
min_list(L1,MinX), min_list(L2,MinY), MinX > MinY |
|
||||
max_list(L2,MaxY), Y::MinX..MaxY.
|
||||
X le Y, X::L1, Y::L2 ==> is_list(L1),is_list(L2),
|
||||
max_list(L1,MaxX), max_list(L2,MaxY), MaxX > MaxY |
|
||||
min_list(L1,MinX), X::MinX..MaxY.
|
||||
|
||||
X lt Y, X::L1, Y::L2 ==> is_list(L1), is_list(L2),
|
||||
max_list(L1,MaxX), max_list(L2,MaxY),
|
||||
MaxY1 is MaxY - 1, MaxY1 < MaxX |
|
||||
min_list(L1,MinX), X::MinX..MaxY1.
|
||||
X lt Y, X::L1, Y::L2 ==> is_list(L1), is_list(L2),
|
||||
min_list(L1,MinX), min_list(L2,MinY),
|
||||
MinX1 is MinX + 1, MinX1 > MinY |
|
||||
max_list(L2,MaxY), Y :: MinX1..MaxY.
|
||||
|
||||
X ne Y \ Y::D <=> ground(X), is_list(D), member(X,D) | select(X,D,D1), Y::D1.
|
||||
Y ne X \ Y::D <=> ground(X), is_list(D), member(X,D) | select(X,D,D1), Y::D1.
|
||||
Y::D \ X ne Y <=> ground(X), is_list(D), \+ member(X,D) | true.
|
||||
Y::D \ Y ne X <=> ground(X), is_list(D), \+ member(X,D) | true.
|
||||
|
||||
|
||||
%% interaction with addition
|
||||
%% no backpropagation yet!
|
||||
|
||||
add(X,Y,Z), X::L1, Y::L2 ==> is_list(L1), is_list(L2) |
|
||||
all_addition(L1,L2,L3), Z::L3.
|
||||
|
||||
%% interaction with multiplication
|
||||
%% no backpropagation yet!
|
||||
|
||||
mult(X,Y,Z), X::L1, Y::L2 ==> is_list(L1), is_list(L2) |
|
||||
all_multiplication(L1,L2,L3), Z::L3.
|
||||
|
||||
|
||||
%% auxiliary predicates =============================================
|
||||
|
||||
remove_lower(_,[],L1):- !, L1=[].
|
||||
remove_lower(Min,[X|L],L1):-
|
||||
X@<Min,
|
||||
!,
|
||||
remove_lower(Min,L,L1).
|
||||
remove_lower(Min,[X|L],[X|L1]):-
|
||||
remove_lower(Min,L,L1).
|
||||
|
||||
remove_higher(_,[],L1):- !, L1=[].
|
||||
remove_higher(Max,[X|L],L1):-
|
||||
X@>Max,
|
||||
!,
|
||||
remove_higher(Max,L,L1).
|
||||
remove_higher(Max,[X|L],[X|L1]):-
|
||||
remove_higher(Max,L,L1).
|
||||
|
||||
intersection([], _, []).
|
||||
intersection([Head|L1tail], L2, L3) :-
|
||||
memberchk(Head, L2),
|
||||
!,
|
||||
L3 = [Head|L3tail],
|
||||
intersection(L1tail, L2, L3tail).
|
||||
intersection([_|L1tail], L2, L3) :-
|
||||
intersection(L1tail, L2, L3).
|
||||
|
||||
all_addition(L1,L2,L3) :-
|
||||
setof(Z, X^Y^(member(X,L1), member(Y,L2), Z is X + Y), L3).
|
||||
|
||||
all_multiplication(L1,L2,L3) :-
|
||||
setof(Z, X^Y^(member(X,L1), member(Y,L2), Z is X * Y), L3).
|
||||
|
||||
|
||||
%% EXAMPLE ==========================================================
|
||||
|
||||
/*
|
||||
?- X::[1,2,3,4,5,6,7], Y::[2,4,6,7,8,0], Y lt X, X::4..9, X ne Y,
|
||||
add(X,Y,Z), mult(X,Y,Z).
|
||||
*/
|
||||
|
||||
%% end of handler listdom.pl =================================================
|
||||
%% ===========================================================================
|
||||
|
||||
|
||||
/*
|
||||
|
||||
?- X::[1,2,3,4,5,6,7], Y::[2,4,6,7,8,0], Y lt X, X::4..9, X ne Y,
|
||||
add(X,Y,Z), mult(X,Y,Z).
|
||||
|
||||
Bad call to builtin predicate: _9696 =.. ['add/3__0',AttVar4942,AttVar5155,AttVar6836|_9501] in predicate mknewterm / 3
|
||||
*/
|
||||
30
packages/chr/Examples/primes.chr
Normal file
30
packages/chr/Examples/primes.chr
Normal file
@@ -0,0 +1,30 @@
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% Sieve of eratosthenes to compute primes
|
||||
%% thom fruehwirth 920218-20, 980311
|
||||
%% christian holzbaur 980207 for Sicstus CHR
|
||||
%%
|
||||
%% ported to hProlog by Tom Schrijvers
|
||||
|
||||
:- module(primes,[]).
|
||||
:- use_module(library(chr)).
|
||||
|
||||
:- constraints candidate/1.
|
||||
:- constraints prime/1.
|
||||
|
||||
|
||||
candidate(1) <=> true.
|
||||
candidate(N) <=> primes:prime(N), N1 is N - 1, primes:candidate(N1).
|
||||
|
||||
absorb @ prime(Y) \ prime(X) <=> 0 is X mod Y | true.
|
||||
|
||||
time(N):-
|
||||
cputime(X),
|
||||
candidate(N),
|
||||
cputime( Now),
|
||||
Time is Now-X,
|
||||
write(N-Time), nl.
|
||||
|
||||
cputime( Ts) :-
|
||||
statistics( runtime, [Tm,_]),
|
||||
Ts is Tm/1000.
|
||||
Reference in New Issue
Block a user