34
35:- export(eepsilon/2). 36:- export(eepsilon/3). 37:- export(eval/3). 38:- export(cast/3). 39:- export(castable/2). 40:- export(compare/4). 41:- export(near_compare/4). 42
43:- use_module(library(solution_sequences)). 44
45:- public eval_1/4. 46
47:- multifile check_dupcode:ignore_dupcode/3. 48
50check_dupcode:ignore_dupcode(Head, Source, _) :-
51 '$current_source_module'(Source),
52 member(F/A, [eepsilon/2, eepsilon/3, eval/3, cast/3, castable/2, compare/4, near_compare/4,
53 compare/5, do_eval_cputime/2, do_eval_z/2, reserve_eps/1, near_compare_b/4]),
54 functor(Head, F, A),
55 neck.
56
57eval_1(Type, Arg, eval(Type, Arg, EA), EA).
58
59eval(_, Expr, _) :-
60 var(Expr),
61 !,
62 fail.
63eval(Type, Expr, C) :-
64 do_eval(Expr, Type, C),
65 !.
66eval(Type, Value, C) :-
67 cast(Type, Value, C),
68 !.
69eval(Type, Value, _) :-
70 throw(error(type_error(evaluable, Type:Value), _)).
71
72cast(Type, Value, C) :-
73 ( inner_cast(Type, Value, C)
74 ->true
75 ; integer(Value)
76 ->term_string(Value, String),
77 cast(Type, String, C)
78 ; rational(Value)
79 ->X is numerator(Value),
80 Y is denominator(Value),
81 do_eval(X/Y, Type, C)
82 ).
83
84castable(Type, Value) :-
85 cd_prefix(Type, Pref, _),
86 atom_concat(is_, Pref, Func),
87 Body =.. [Func, Value],
88 necki,
89 Body.
90
91inner_cast(Type, Value, C) :-
92 cd_prefix(Type, Pref, EAL),
93 append([Value|EAL], [C], AL),
94 Body =.. [Pref|AL],
95 necki,
96 Body.
97
98do_eval_cputime(T, V) :-
99 X is cputime,
100 inner_cast(T, X, V).
101
102do_eval_z(Type, C) :- cast(Type, 0, C).
103
104eepsilon(T, E) :-
105 reserve_eps(N),
106 eval(T, N*epsilon, E).
107
108eepsilon(T, N, E) :-
109 eepsilon(T, R),
110 eval(T, R*N, E).
111
112compare(Type, Op, A, B) :-
113 eval(Type, A, X),
114 eval(Type, B, Y),
115 compare_b(Op, Type, X, Y).
116
117near_compare(Type, Op, A, B) :-
118 eval(Type, A, X),
119 eval(Type, B, Y),
120 near_compare_b(Type, Op, X, Y).
121
122near_compare_b(Type, Op, X, Y) :-
123 ( compare_b(=, Type, X, Y)
124 ->compare_eq(Op)
125 ; eepsilon(Type, max(abs(X), abs(Y)), E),
126 compare(Op, Type, X, Y, E)
127 ).
128
129compare(=, T, A, B, E) :- compare(T, =<, abs(A - B), E).
130compare(=<, T, A, B, E) :- compare(T, =<, A - B, E).
131compare(>=, T, A, B, E) :- compare(T, =<, B - A, E).
132compare(<, T, A, B, E) :- compare(T, >, B - A, E).
133compare(>, T, A, B, E) :- compare(T, >, A - B, E).
134compare(\=, T, A, B, E) :- compare(T, >, abs(A - B), E).
135
136compare_b(Op, Type, X, Y) :-
137 op_pred(Op, Pred),
138 Body =.. [Pred, Type, X, Y],
139 necki,
140 Body.
141
142Head :-
143 op_pred(_, Pred),
144 Head =.. [Pred, Type, X, Y],
145 cd_prefix(Type, Pref, _),
146 atomic_list_concat([Pref, '_', Pred], F),
147 Body =.. [F, X, Y],
148 necki,
149 Body.
150
151Head :-
152 distinct(Pred, expr_pred(_, Pred)),
153 Pred =.. [Name|AL],
154 Head =.. [Name, Type, C|AL],
155 cd_prefix(Type, Pref, EAL),
156 atomic_list_concat([Pref, '_', Name], BN),
157 append(EAL, [C|AL], BL),
158 Body =.. [BN|BL],
159 necki,
160 Body