New feature for adding unconditional simplification rules.
[chr.git] / builtins.pl
blobad1cffdf8d225d41ca0df0147b6fdd475e529ffe
1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2 % Author: Tom Schrijvers
3 % Email: Tom.Schrijvers@cs.kuleuven.be
4 % Copyright: K.U.Leuven 2004
5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
6 :- module(builtins,
8 negate_b/2,
9 entails_b/2,
10 binds_b/2,
11 builtin_binds_b/2
12 ]).
14 :- use_module(hprolog).
16 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
17 negate_b(A,B) :- once(negate(A,B)).
18 negate((A,B),NotB) :- A==true,negate(B,NotB). % added by jon
19 negate((A,B),NotA) :- B==true,negate(A,NotA). % added by jon
20 negate((A,B),(NotA;NotB)) :- negate(A,NotA),negate(B,NotB). % added by jon
21 negate((A;B),(NotA,NotB)) :- negate(A,NotA),negate(B,NotB). % added by jon
22 negate(true,fail).
23 negate(fail,true).
24 negate(X =< Y, Y < X).
25 negate(X > Y, Y >= X).
26 negate(X >= Y, Y > X).
27 negate(X < Y, Y =< X).
28 negate(X == Y, X \== Y). % added by jon
29 negate(X \== Y, X == Y). % added by jon
30 negate(X =:= Y, X =\= Y). % added by jon
31 negate(X is Y, X =\= Y). % added by jon
32 negate(X =\= Y, X =:= Y). % added by jon
33 negate(X = Y, X \= Y). % added by jon
34 negate(X \= Y, X = Y). % added by jon
35 negate(var(X),nonvar(X)).
36 negate(nonvar(X),var(X)).
37 negate(\+ X,X). % added by jon
38 negate(X,\+ X). % added by jon
40 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
41 entails_b(fail,_) :-!.
42 entails_b(A,B) :-
43 ( var(B) ->
44 entails(A,B,[A])
46 once((
47 entails(A,C,[A]),
48 B == C
52 entails(A,A,_).
53 entails(A,C,History) :-
54 entails_(A,B),
55 \+ hprolog:memberchk_eq(B,History),
56 entails(B,C,[B|History]).
58 entails_(X > Y, X >= Y).
59 entails_(X > Y, Y < X).
60 entails_(X >= Y, Y =< X).
61 entails_(X =< Y, Y >= X). %added by jon
62 entails_(X < Y, Y > X).
63 entails_(X < Y, X =< Y).
64 entails_(X > Y, X \== Y).
65 entails_(X \== Y, Y \== X).
66 entails_(X == Y, Y == X).
67 entails_(X == Y, X =:= Y) :- ground(X). %added by jon
68 entails_(X == Y, X =:= Y) :- ground(Y). %added by jon
69 entails_(X \== Y, X =\= Y) :- ground(X). %added by jon
70 entails_(X \== Y, X =\= Y) :- ground(Y). %added by jon
71 entails_(X =:= Y, Y =:= X). %added by jon
72 entails_(X =\= Y, Y =\= X). %added by jon
73 entails_(X == Y, X >= Y). %added by jon
74 entails_(X == Y, X =< Y). %added by jon
75 entails_(ground(X),nonvar(X)).
76 entails_(compound(X),nonvar(X)).
77 entails_(atomic(X),nonvar(X)).
78 entails_(number(X),nonvar(X)).
79 entails_(atom(X),nonvar(X)).
80 entails_(fail,true).
82 builtin_binds_b(G,Vars) :-
83 builtin_binds_(G,L,[]),
84 sort(L,Vars).
86 builtin_binds_(var(_),L,L).
87 builtin_binds_(nonvar(_),L,L).
88 builtin_binds_(ground(_),L,L).
89 builtin_binds_(compound(_),L,L).
90 builtin_binds_(number(_),L,L).
91 builtin_binds_(atom(_),L,L).
92 builtin_binds_(atomic(_),L,L).
93 builtin_binds_(integer(_),L,L).
94 builtin_binds_(float(_),L,L).
96 builtin_binds_(_ > _ ,L,L).
97 builtin_binds_(_ < _ ,L,L).
98 builtin_binds_(_ =< _,L,L).
99 builtin_binds_(_ >= _,L,L).
100 builtin_binds_(_ =:= _,L,L).
101 builtin_binds_(_ =\= _,L,L).
102 builtin_binds_(_ == _,L,L).
103 builtin_binds_(_ \== _,L,L).
104 builtin_binds_(true,L,L).
106 builtin_binds_(X is _,[X|L],L).
107 builtin_binds_((G1,G2),L,T) :-
108 builtin_binds_(G1,L,R),
109 builtin_binds_(G2,R,T).
110 builtin_binds_((G1;G2),L,T) :-
111 builtin_binds_(G1,L,R),
112 builtin_binds_(G2,R,T).
113 builtin_binds_((G1->G2),L,T) :-
114 builtin_binds_(G1,L,R),
115 builtin_binds_(G2,R,T).
117 builtin_binds_(\+ G,L,T) :-
118 builtin_binds_(G,L,T).
119 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
120 binds_b(G,Vars) :-
121 binds_(G,L,[]),
122 sort(L,Vars).
124 binds_(var(_),L,L).
125 binds_(nonvar(_),L,L).
126 binds_(ground(_),L,L).
127 binds_(compound(_),L,L).
128 binds_(number(_),L,L).
129 binds_(atom(_),L,L).
130 binds_(atomic(_),L,L).
131 binds_(integer(_),L,L).
132 binds_(float(_),L,L).
134 binds_(_ > _ ,L,L).
135 binds_(_ < _ ,L,L).
136 binds_(_ =< _,L,L).
137 binds_(_ >= _,L,L).
138 binds_(_ =:= _,L,L).
139 binds_(_ =\= _,L,L).
140 binds_(_ == _,L,L).
141 binds_(_ \== _,L,L).
142 binds_(true,L,L).
144 binds_(X is _,[X|L],L).
145 binds_((G1,G2),L,T) :-
146 binds_(G1,L,R),
147 binds_(G2,R,T).
148 binds_((G1;G2),L,T) :-
149 binds_(G1,L,R),
150 binds_(G2,R,T).
151 binds_((G1->G2),L,T) :-
152 binds_(G1,L,R),
153 binds_(G2,R,T).
155 binds_(\+ G,L,T) :-
156 binds_(G,L,T).
158 binds_(G,L,T) :- term_variables(G,GVars),append(GVars,T,L). %jon