1:- module(st_expr, [
2 st_eval/4, 3 st_set_function/3, 4 st_set_global/2 5]).
13:- use_module(library(error)). 14
15:- dynamic(user_function/3). 16
17:- meta_predicate(st_set_function(+, +, :)).
25st_set_function(Name, Arity, Goal):-
26 must_be(atom, Name),
27 must_be(nonneg, Arity),
28 must_be(nonvar, Goal),
29 assert_function(Name, Arity, Goal).
30
31assert_function(Name, Arity, Goal):-
32 ( user_function(Name, Arity, Goal)
33 -> true
34 ; assertz(user_function(Name, Arity, Goal))).
35
36:- dynamic(global/2).
44st_set_global(Name, Value):-
45 must_be(atom, Name),
46 must_be(ground, Value),
47 retractall(global(Name, _)),
48 assertz(global(Name, Value)).
49
51
52st_eval(String, _, _, String):-
53 string(String), !.
54
56
57st_eval(Number, _, _, Number):-
58 number(Number), !.
59
61
62st_eval(Name, Scope, Options, Value):-
63 atom(Name), !,
64 ( get_dict(Name, Scope, Value)
65 -> true
66 ; ( global(Name, Value)
67 -> true
68 ; option(undefined(Undefined), Options, error),
69 ( Undefined = false
70 -> Value = false
71 ; throw(error(no_entry(Name)))))).
72
74
75st_eval(\+(Cond), Scope, Options, Value):- !,
76 st_eval_bool(Cond, Scope, Options, Bool),
77 bool_neg(Bool, Value).
78
80
81st_eval(Left < Right, Scope, Options, Value):- !,
82 st_eval(Left, Scope, Options, LeftValue),
83 st_eval(Right, Scope, Options, RightValue),
84 ( LeftValue < RightValue
85 -> Value = 1
86 ; Value = 0).
87
89
90st_eval(Left > Right, Scope, Options, Value):- !,
91 st_eval(Left, Scope, Options, LeftValue),
92 st_eval(Right, Scope, Options, RightValue),
93 ( LeftValue > RightValue
94 -> Value = 1
95 ; Value = 0).
96
98
99st_eval(Left = Right, Scope, Options, Value):- !,
100 st_eval(Left, Scope, Options, LeftValue),
101 st_eval(Right, Scope, Options, RightValue),
102 ( test_equality(LeftValue, RightValue)
103 -> Value = 1
104 ; Value = 0).
105
107
108st_eval(Left \= Right, Scope, Options, Value):- !,
109 st_eval(Left, Scope, Options, LeftValue),
110 st_eval(Right, Scope, Options, RightValue),
111 ( test_equality(LeftValue, RightValue)
112 -> Value = 0
113 ; Value = 1).
114
116
117st_eval(Left =< Right, Scope, Options, Value):- !,
118 st_eval(Left, Scope, Options, LeftValue),
119 st_eval(Right, Scope, Options, RightValue),
120 ( LeftValue =< RightValue
121 -> Value = 1
122 ; Value = 0).
123
125
126st_eval(Left >= Right, Scope, Options, Value):- !,
127 st_eval(Left, Scope, Options, LeftValue),
128 st_eval(Right, Scope, Options, RightValue),
129 ( LeftValue >= RightValue
130 -> Value = 1
131 ; Value = 0).
132
134
135st_eval(','(Left, Right), Scope, Options, Value):- !,
136 st_eval_bool(Left, Scope, Options, LeftValue),
137 ( LeftValue = 0
138 -> Value = 0
139 ; st_eval_bool(Right, Scope, Options, RightValue),
140 ( RightValue = 0
141 -> Value = 0
142 ; Value = 1)).
143
145
146st_eval(';'(Left, Right), Scope, Options, Value):- !,
147 st_eval_bool(Left, Scope, Options, LeftValue),
148 ( LeftValue = 1
149 -> Value = 1
150 ; st_eval_bool(Right, Scope, Options, RightValue),
151 ( RightValue = 1
152 -> Value = 1
153 ; Value = 0)).
154
156
157st_eval(-(Expr), Scope, Options, Value):- !,
158 st_eval(Expr, Scope, Options, ExprValue),
159 Value is -ExprValue.
160
162
163st_eval(+(Expr), Scope, Options, Value):- !,
164 st_eval(Expr, Scope, Options, ExprValue),
165 Value is ExprValue.
166
168
169st_eval(Term, Scope, Options, Value):-
170 Term =.. ['.', Base, Name], !,
171 st_eval(Base, Scope, Options, Tmp),
172 '.'(Tmp, Name, Value).
173
175
176st_eval(Left + Right, Scope, Options, Value):- !,
177 st_eval(Left, Scope, Options, LeftValue),
178 st_eval(Right, Scope, Options, RightValue),
179 ( number(LeftValue)
180 -> Value is LeftValue + RightValue
181 ; string_concat(LeftValue, RightValue, Value)).
182
184
185st_eval(Left - Right, Scope, Options, Value):- !,
186 st_eval(Left, Scope, Options, LeftValue),
187 st_eval(Right, Scope, Options, RightValue),
188 Value is LeftValue - RightValue.
189
191
192st_eval(Left * Right, Scope, Options, Value):- !,
193 st_eval(Left, Scope, Options, LeftValue),
194 st_eval(Right, Scope, Options, RightValue),
195 Value is LeftValue * RightValue.
196
198
199st_eval(Left / Right, Scope, Options, Value):- !,
200 st_eval(Left, Scope, Options, LeftValue),
201 st_eval(Right, Scope, Options, RightValue),
202 Value is LeftValue / RightValue.
203
205
206st_eval(Left mod Right, Scope, Options, Value):- !,
207 st_eval(Left, Scope, Options, LeftValue),
208 st_eval(Right, Scope, Options, RightValue),
209 Value is LeftValue mod RightValue.
210
212
213st_eval(Left rem Right, Scope, Options, Value):- !,
214 st_eval(Left, Scope, Options, LeftValue),
215 st_eval(Right, Scope, Options, RightValue),
216 Value is LeftValue rem RightValue.
217
219
220st_eval(Left // Right, Scope, Options, Value):- !,
221 st_eval(Left, Scope, Options, LeftValue),
222 st_eval(Right, Scope, Options, RightValue),
223 Value is LeftValue // RightValue.
224
226
227st_eval(Left div Right, Scope, Options, Value):- !,
228 st_eval(Left, Scope, Options, LeftValue),
229 st_eval(Right, Scope, Options, RightValue),
230 Value is LeftValue div RightValue.
231
233
234st_eval(abs(Expr), Scope, Options, Abs):- !,
235 st_eval(Expr, Scope, Options, Value),
236 Abs is abs(Value).
237
239
240st_eval(sign(Expr), Scope, Options, Sign):- !,
241 st_eval(Expr, Scope, Options, Value),
242 Sign is sign(Value).
243
245
246st_eval(max(Left, Right), Scope, Options, Value):- !,
247 st_eval(Left, Scope, Options, LeftValue),
248 st_eval(Right, Scope, Options, RightValue),
249 Value is max(LeftValue, RightValue).
250
252
253st_eval(min(Left, Right), Scope, Options, Value):- !,
254 st_eval(Left, Scope, Options, LeftValue),
255 st_eval(Right, Scope, Options, RightValue),
256 Value is min(LeftValue, RightValue).
257
259
260st_eval(random(Expr), Scope, Options, Sign):- !,
261 st_eval(Expr, Scope, Options, Value),
262 Sign is random(Value).
263
265
266st_eval(round(Expr), Scope, Options, Sign):- !,
267 st_eval(Expr, Scope, Options, Value),
268 Sign is round(Value).
269
271
272st_eval(truncate(Expr), Scope, Options, Sign):- !,
273 st_eval(Expr, Scope, Options, Value),
274 Sign is truncate(Value).
275
277
278st_eval(floor(Expr), Scope, Options, Sign):- !,
279 st_eval(Expr, Scope, Options, Value),
280 Sign is floor(Value).
281
283
284st_eval(ceiling(Expr), Scope, Options, Sign):- !,
285 st_eval(Expr, Scope, Options, Value),
286 Sign is ceiling(Value).
287
289
290st_eval(Left ** Right, Scope, Options, Value):- !,
291 st_eval(Left, Scope, Options, LeftValue),
292 st_eval(Right, Scope, Options, RightValue),
293 Value is LeftValue ** RightValue.
294
296
297st_eval(Left ^ Right, Scope, Options, Value):- !,
298 st_eval(Left, Scope, Options, LeftValue),
299 st_eval(Right, Scope, Options, RightValue),
300 Value is LeftValue ^ RightValue.
301
303
304st_eval(if(Cond, True, False), Scope, Options, Value):- !,
305 st_eval_bool(Cond, Scope, Options, CondValue),
306 ( CondValue = 0
307 -> st_eval(False, Scope, Options, Value)
308 ; st_eval(True, Scope, Options, Value)).
309
311
312st_eval(atom(Atom), _, _, Atom):-
313 atom(Atom), !.
314
316
317st_eval(List, Scope, Options, Value):-
318 is_list(List), !,
319 st_eval_list(List, Scope, Options, Value).
320
322
323st_eval(Compound, Scope, Options, Value):-
324 compound(Compound), !,
325 function_call(Compound, Scope, Options, Value).
326
327st_eval_bool(Expr, Scope, Options, Bool):-
328 st_eval(Expr, Scope, Options, Value),
329 ( (Value = 0 ; Value = false)
330 -> Bool = 0
331 ; Bool = 1).
332
333bool_neg(1, 0).
334bool_neg(0, 1).
335
337
338st_eval_list([Expr|Exprs], Scope, Options, [Value|Values]):-
339 st_eval(Expr, Scope, Options, Value),
340 st_eval_list(Exprs, Scope, Options, Values).
341
342st_eval_list([], _, _, []).
343
346
347test_equality(Value1, Value2):-
348 ( string(Value1)
349 -> ( string(Value2)
350 -> Value1 = Value2
351 ; test_equality_string(Value1, Value2))
352 ; ( string(Value2)
353 -> test_equality_string(Value2, Value1)
354 ; Value1 = Value2)).
355
356test_equality_string(String, Value):-
357 ( string(Value)
358 -> String = Value
359 ; atom(Value),
360 atom_string(Value, TestString),
361 String = TestString).
362
363function_call(Fun, Scope, Options, Value):-
364 Fun =.. [Name|Args],
365 length(Args, Arity),
366 ( user_function(Name, Arity, Goal)
367 -> st_eval_list(Args, Scope, Options, Vals),
368 append(Vals, [Value], GoalArgs),
369 ( apply(Goal, GoalArgs)
370 -> true
371 ; throw(error(function_call_failed(GoalArgs))))
372 ; throw(error(no_function(Name/Arity))))
Expression evaluator
Evaluates expression. Allows registering of global constants and user-defined functions. */