1:- module(relational_clpq, [
2 op(700, xfx, :>:),
3 op(700, xfx, :<:),
4 op(700, xfx, :>=:),
5 op(700, xfx, :=<:),
6 op(700, xfx, :=:),
7 op(700, xfx, :\=:)
8]). 9
10:- use_module(library(clpfd)). 11:- set_prolog_flag(clpfd_monotonic, true). 12
13
22
24:- op(700, xfx, :>:). 25:- op(700, xfx, :<:). 26:- op(700, xfx, :>=:). 27:- op(700, xfx, :=<:). 28:- op(700, xfx, :=:). 29:- op(700, xfx, :\=:). 30
36
37A :=: B :- phrase(eval(A :=: B,_),_).
38
39A :\=: B :- phrase(eval(A :\=: B,_),_).
40
41A :=<: B :- phrase(eval(A :=<: B,_),_).
42
43A :<: B :- phrase(eval(A :<: B,_),_).
44
45A :>=: B :- phrase(eval(B :=<: A,_),_).
46
47A :>: B :- phrase(eval(B :<: A,_),_).
48
49eval(N,N/1) --> {number(N)}, !.
50eval(V,V/1) --> {var(V)}, !.
51
52eval((L * R), Numerator/Denominator) -->
53 eval(L,LP/LQ), eval(R,RP/RQ),
54 {#(Numerator) #= #(LP) * #(RP), #(Denominator) #= #(LQ) * #(RQ)}.
55
56eval((L / R), Numerator/Denominator) -->
57 eval(L,LP/LQ), eval(R,RP/RQ),
58 {#(Numerator) #= #(LP) * #(RQ), #(Denominator) #= #(LQ) * #(RP)}.
59
60eval((L + R), Numerator/Denominator) -->
61 eval(L,LP/LQ), eval(R,RP/RQ),
62 {
63 #(LQ) #= #(RQ),
64 #(Numerator) #= #(LP) + #(RP),
65 #(Denominator) #= #(LQ)
66 ;
67 #(LQ) #\= #(RQ),
68 #(LP_RQ) #= #(LP) * #(RQ), #(RP_LQ) #= #(RP) * #(LQ),
69 #(Numerator) #= #(LP_RQ) + #(RP_LQ),
70 #(Denominator) #= #(LQ) * #(RQ)
71 }.
72
73eval((L - R), Numerator/Denominator) -->
74 eval(L,LP/LQ), eval(R,RP/RQ),
75 {
76 #(LQ) #= #(RQ),
77 #(Numerator) #= #(LP) - #(RP),
78 #(Denominator) #= #(LQ)
79 ;
80 #(LP_RQ) #= #(LP) * #(RQ), #(RP_LQ) #= #(RP) * #(LQ),
81 #(Numerator) #= #(LP_RQ) - #(RP_LQ),
82 #(Denominator) #= #(LQ) * #(RQ)
83 }.
84
85eval((L :=: R), true) -->
86 eval(L,LP/LQ), eval(R,RP/RQ),
87 {#(LP) * #(RQ) #= #(RP) * #(LQ)}.
88
89eval((L :\=: R), true) -->
90 eval(L,LP/LQ), eval(R,RP/RQ),
91 {#(LP) * #(RQ) #\= #(RP) * #(LQ)}.
92
93eval((L :=<: R), true) -->
94 eval(L,LP/LQ), eval(R,RP/RQ),
95 {#(LP) * #(RQ) #=< #(RP) * #(LQ)}.
96
97eval((L :<: R), true) -->
98 eval(L,LP/LQ), eval(R,RP/RQ),
99 {#(LP) * #(RQ)