A small standalone Lisp used as a scripting language in the Z2 game engine
Revision | bbe281179bed7d4ec2e9f102648a12ebd87d631e (tree) |
---|---|
Zeit | 2019-07-28 06:29:30 |
Autor | AlaskanEmily <emily@alas...> |
Commiter | AlaskanEmily |
Remove modules which were supposed to be renamed
@@ -1,165 +0,0 @@ | ||
1 | -:- module tl_runtime.builtin.arithmetic. | |
2 | - | |
3 | -%=============================================================================% | |
4 | -% Turbolisp implementation details for arithmetic builtins. | |
5 | -:- interface. | |
6 | -%=============================================================================% | |
7 | - | |
8 | -:- func int_to_float(int::in) = (float::uo) is det. | |
9 | - | |
10 | -%-----------------------------------------------------------------------------% | |
11 | - | |
12 | -:- func inc(int) = int. | |
13 | - | |
14 | -%-----------------------------------------------------------------------------% | |
15 | - | |
16 | -:- type math_pred == (pred(number, number, string)). | |
17 | -:- mode math_pred == (pred(in, in, uo) is det). | |
18 | -:- inst math_pred == (pred(in, in, uo) is det). | |
19 | - | |
20 | -%-----------------------------------------------------------------------------% | |
21 | -% TODO: Variadic + and *? | |
22 | -:- pred builtin_plus `with_type` math_pred `with_inst` math_pred. | |
23 | -:- pred builtin_minus `with_type` math_pred `with_inst` math_pred. | |
24 | -:- pred builtin_times `with_type` math_pred `with_inst` math_pred. | |
25 | -:- pred builtin_divide `with_type` math_pred `with_inst` math_pred. | |
26 | - | |
27 | -%-----------------------------------------------------------------------------% | |
28 | - | |
29 | -:- pred builtin_arithmetic_bind(math_pred, arithmetic, list(element), result). | |
30 | -:- mode builtin_arithmetic_bind(math_pred, in, in, res_uo) is det. | |
31 | - | |
32 | -%=============================================================================% | |
33 | -% Most of the implementation of the arithmetic submodule is private. | |
34 | -:- implementation. | |
35 | -%=============================================================================% | |
36 | - | |
37 | -:- use_module int. | |
38 | -:- import_module float. | |
39 | - | |
40 | -%-----------------------------------------------------------------------------% | |
41 | - | |
42 | -:- pragma inline(int_to_float/1). | |
43 | - | |
44 | -%-----------------------------------------------------------------------------% | |
45 | - | |
46 | -int_to_float(I) = ((0.0)+float(I)). | |
47 | - | |
48 | -%-----------------------------------------------------------------------------% | |
49 | - | |
50 | -inc(I) = int.plus(I, 1). | |
51 | - | |
52 | -%-----------------------------------------------------------------------------% | |
53 | - | |
54 | -:- func float_plus(float::in, float::in) = (float::uo) is det. | |
55 | -:- func float_minus(float::in, float::in) = (float::uo) is det. | |
56 | -:- func float_times(float::in, float::in) = (float::uo) is det. | |
57 | -:- func float_divide(float::in, float::in) = (float::uo) is det. | |
58 | - | |
59 | -float_plus(A, B) = (A+B). | |
60 | -float_minus(A, B) = (A-B). | |
61 | -float_times(A, B) = (A*B). | |
62 | -float_divide(A, B) = (A/B). | |
63 | - | |
64 | -%-----------------------------------------------------------------------------% | |
65 | - | |
66 | -:- pred two_atoms(element, element, maybe.maybe_error({string, string})). | |
67 | -:- mode two_atoms(in, in, out(maybe_unique_error)) is det. | |
68 | - | |
69 | -two_atoms(list(_), list(_), maybe.error("Args 1 and 2 not atoms")). | |
70 | -two_atoms(atom(_), list(_), maybe.error("Arg 2 not atom")). | |
71 | -two_atoms(list(_), atom(_), maybe.error("Arg 1 not atom")). | |
72 | -two_atoms(atom(A), atom(B), maybe.ok({A, B})). | |
73 | - | |
74 | -:- pragma inline(two_atoms/3). | |
75 | - | |
76 | -%-----------------------------------------------------------------------------% | |
77 | - | |
78 | -:- pred two_atoms(list.list(element), maybe.maybe_error({string, string})). | |
79 | -:- mode two_atoms(in, out(maybe_unique_error)) is det. | |
80 | - | |
81 | -:- pragma inline(two_atoms/2). | |
82 | - | |
83 | -two_atoms(Args, Result) :- | |
84 | - ( | |
85 | - Args = [], | |
86 | - Result = maybe.error("no values") | |
87 | - ; | |
88 | - Args = [_|[]], | |
89 | - Result = maybe.error("not 2 values (1)") | |
90 | - ; | |
91 | - Args = [_|[_|[_|_]]], | |
92 | - Result = maybe.error(string.append(string.append( | |
93 | - "not 2 values (", string.from_int(list.length(Args))), | |
94 | - ")")) | |
95 | - ; | |
96 | - Args = [A|[B|[]]], | |
97 | - two_atoms(A, B, Result) | |
98 | - ). | |
99 | - | |
100 | -%-----------------------------------------------------------------------------% | |
101 | - | |
102 | -:- func arithmetic(func(int, int) = int, func(float, float) = float, | |
103 | - number, number) = (string). | |
104 | -:- mode arithmetic(func(in, in) = (out) is det, func(in, in) = (uo) is det, | |
105 | - in, in) = (uo) is det. | |
106 | - | |
107 | -arithmetic(Func, _, int(A), int(B)) = string.from_int(Func(A, B)). | |
108 | -arithmetic(_, Func, float(A), float(B)) = string.from_float(Func(A, B)). | |
109 | -arithmetic(_, Func, int(A), float(B)) = string.from_float(Func(float(A), B)). | |
110 | -arithmetic(_, Func, float(A), int(B)) = string.from_float(Func(A, float(B))). | |
111 | - | |
112 | -%-----------------------------------------------------------------------------% | |
113 | - | |
114 | -builtin_plus(ANum, BNum, arithmetic(int.plus, float_plus, ANum, BNum)). | |
115 | -builtin_minus(ANum, BNum, arithmetic(int.minus, float_minus, ANum, BNum)). | |
116 | -builtin_times(ANum, BNum, arithmetic(int.times, float_times, ANum, BNum)). | |
117 | -builtin_divide(ANum, BNum, arithmetic('int__div', float_divide, ANum, BNum)). | |
118 | - | |
119 | -%-----------------------------------------------------------------------------% | |
120 | -% Implementation of arithmetic operators. | |
121 | -:- pred arithmetic(math_pred, | |
122 | - arithmetic, list.list(element), result). | |
123 | -:- mode arithmetic(math_pred, | |
124 | - in, in, res_uo) is det. | |
125 | - | |
126 | -:- pragma inline(arithmetic/4). | |
127 | - | |
128 | -arithmetic(Pred, Op, Args, Result) :- | |
129 | - two_atoms(Args, ArgsResult), | |
130 | - ( | |
131 | - ArgsResult = maybe.error(Error), | |
132 | - builtin_op_tag(arithmetic(Op), Tag), | |
133 | - Result = maybe.error(func_error(Tag, 2, Error)) | |
134 | - ; | |
135 | - ArgsResult = maybe.ok({AStr, BStr}), | |
136 | - ( if | |
137 | - number_type(AStr, ANum) | |
138 | - then | |
139 | - ( if | |
140 | - number_type(BStr, BNum) | |
141 | - then | |
142 | - Pred(ANum, BNum, Out), | |
143 | - Result = maybe.ok(atom(Out)) | |
144 | - else | |
145 | - builtin_op_tag(arithmetic(Op), Tag), | |
146 | - Result = maybe.error(func_error( | |
147 | - Tag, | |
148 | - 2, | |
149 | - string.append(string.append( | |
150 | - "arg 2 not a number (", BStr), ")"))) | |
151 | - ) | |
152 | - else | |
153 | - builtin_op_tag(arithmetic(Op), Tag), | |
154 | - Result = maybe.error(func_error( | |
155 | - Tag, | |
156 | - 2, | |
157 | - string.append(string.append( | |
158 | - "arg 1 not a number (", AStr), ")"))) | |
159 | - ) | |
160 | - ). | |
161 | - | |
162 | -%-----------------------------------------------------------------------------% | |
163 | - | |
164 | -builtin_arithmetic_bind(Pred, Op, Args, Out) :- arithmetic(Pred, Op, Args, Out). | |
165 | - |
@@ -1,77 +0,0 @@ | ||
1 | -:- module tl_runtime.builtin.comparison. | |
2 | - | |
3 | -%=============================================================================% | |
4 | -% Turbolisp implementation details for comparison builtins. | |
5 | -:- interface. | |
6 | -%=============================================================================% | |
7 | - | |
8 | -:- func inverse(cmp_result) = cmp_result. | |
9 | -:- mode inverse(di) = (uo) is det. | |
10 | -:- mode inverse(in) = (out) is det. | |
11 | - | |
12 | -%-----------------------------------------------------------------------------% | |
13 | - | |
14 | -:- pred builtin_comparison_bind(cmp_pred, list(element), result, runtime, runtime). | |
15 | -:- mode builtin_comparison_bind(cmp_pred, in, res_uo, in, out) is det. | |
16 | - | |
17 | -%-----------------------------------------------------------------------------% | |
18 | - | |
19 | -:- pred atom_compare(string::in, string::in, comparison_result::uo) is det. | |
20 | - | |
21 | -%=============================================================================% | |
22 | -:- implementation. | |
23 | -%=============================================================================% | |
24 | - | |
25 | -:- use_module exception. | |
26 | - | |
27 | -%-----------------------------------------------------------------------------% | |
28 | - | |
29 | -:- pragma inline(builtin_comparison_bind/5). | |
30 | -:- pragma inline(inverse/1). | |
31 | - | |
32 | -%-----------------------------------------------------------------------------% | |
33 | - | |
34 | -inverse(error(Error)) = error(Error). | |
35 | -inverse(yes) = no. | |
36 | -inverse(no) = yes. | |
37 | - | |
38 | -%-----------------------------------------------------------------------------% | |
39 | - | |
40 | -builtin_comparison_bind(Pred, Args, Result, !Runtime) :- | |
41 | - ( if | |
42 | - Args = [A, B, Y, N] | |
43 | - then | |
44 | - Pred(A, B, CmpResult), | |
45 | - ( | |
46 | - CmpResult = yes, | |
47 | - Result = maybe.ok(Y) | |
48 | - ; | |
49 | - CmpResult = no, | |
50 | - Result = maybe.ok(N) | |
51 | - ; | |
52 | - CmpResult = error(Error), | |
53 | - Result = maybe.error(Error) | |
54 | - ) | |
55 | - else | |
56 | - exception.throw(exception.software_error( | |
57 | - "Wrong arity in comparison func (builtin_bind is probably broken)")) | |
58 | - ). | |
59 | - | |
60 | -%-----------------------------------------------------------------------------% | |
61 | - | |
62 | -atom_compare(A, B, Cmp) :- | |
63 | - ( if | |
64 | - number_type(A, ANum), | |
65 | - number_type(B, BNum) | |
66 | - then | |
67 | - ( if | |
68 | - as_int(ANum, BNum, AInt, BInt) | |
69 | - then | |
70 | - builtin.compare(Cmp, AInt, BInt) | |
71 | - else | |
72 | - promote(ANum, BNum, AFloat, BFloat), | |
73 | - builtin.compare(Cmp, AFloat, BFloat) | |
74 | - ) | |
75 | - else | |
76 | - builtin.compare(Cmp, A, B) | |
77 | - ). |
@@ -1,476 +0,0 @@ | ||
1 | -:- module tl_runtime.builtin. | |
2 | - | |
3 | -%=============================================================================% | |
4 | -% Turbolisp builtins | |
5 | -:- interface. | |
6 | -%=============================================================================% | |
7 | - | |
8 | -:- use_module enum. | |
9 | - | |
10 | -%-----------------------------------------------------------------------------% | |
11 | - | |
12 | -:- type arithmetic ---> | |
13 | - plus ; | |
14 | - minus ; | |
15 | - times ; | |
16 | - divide. | |
17 | - | |
18 | -%-----------------------------------------------------------------------------% | |
19 | - | |
20 | -:- instance enum.enum(arithmetic). | |
21 | - | |
22 | -%-----------------------------------------------------------------------------% | |
23 | - | |
24 | -:- type logic ---> | |
25 | - int_and ; | |
26 | - int_or ; | |
27 | - int_xor. | |
28 | - | |
29 | -%-----------------------------------------------------------------------------% | |
30 | - | |
31 | -:- instance enum.enum(logic). | |
32 | - | |
33 | -%-----------------------------------------------------------------------------% | |
34 | - | |
35 | -:- type comparison ---> | |
36 | - eq ; | |
37 | - ne ; | |
38 | - lt ; | |
39 | - gt ; | |
40 | - le ; | |
41 | - ge. | |
42 | - | |
43 | -%-----------------------------------------------------------------------------% | |
44 | - | |
45 | -:- instance enum.enum(comparison). | |
46 | - | |
47 | -%-----------------------------------------------------------------------------% | |
48 | - | |
49 | -:- pred comparison_tag(comparison, string). | |
50 | -:- mode comparison_tag(in, out) is det. | |
51 | -:- mode comparison_tag(out, in) is semidet. | |
52 | -:- mode comparison_tag(out, ui) is semidet. % Iffy | |
53 | -:- mode comparison_tag(in, in) is semidet. % Implied | |
54 | - | |
55 | -%-----------------------------------------------------------------------------% | |
56 | - | |
57 | -:- type define ---> | |
58 | - def ; | |
59 | - let ; | |
60 | - fn. | |
61 | - | |
62 | -%-----------------------------------------------------------------------------% | |
63 | - | |
64 | -:- instance enum.enum(define). | |
65 | - | |
66 | -%-----------------------------------------------------------------------------% | |
67 | - | |
68 | -:- type builtin_op ---> | |
69 | - arithmetic(arithmetic) ; | |
70 | - logic(logic) ; | |
71 | - comparison(comparison) ; | |
72 | - define(define). | |
73 | - | |
74 | -%-----------------------------------------------------------------------------% | |
75 | - | |
76 | -:- instance enum.enum(builtin_op). | |
77 | - | |
78 | -%-----------------------------------------------------------------------------% | |
79 | - | |
80 | -:- pred builtin_op_enum(builtin_op, int). | |
81 | -:- mode builtin_op_enum(in, out) is det. | |
82 | -:- mode builtin_op_enum(out, in) is semidet. | |
83 | -:- mode builtin_op_enum(in, in) is semidet. % Implied | |
84 | - | |
85 | -%-----------------------------------------------------------------------------% | |
86 | - | |
87 | -:- pred builtin_op_tag(builtin_op, string). | |
88 | -:- mode builtin_op_tag(in, out) is det. | |
89 | -:- mode builtin_op_tag(out, in) is semidet. | |
90 | -:- mode builtin_op_tag(out, ui) is semidet. % Iffy | |
91 | -:- mode builtin_op_tag(in, in) is semidet. % Implied | |
92 | - | |
93 | -%-----------------------------------------------------------------------------% | |
94 | -% Numeric components shared between comparison, arithmetic, and logic. | |
95 | -%-----------------------------------------------------------------------------% | |
96 | - | |
97 | -% Used to determine if a number is a float or an int. | |
98 | -:- type number ---> float(float) ; int(int). | |
99 | - | |
100 | -%-----------------------------------------------------------------------------% | |
101 | -% Promotes both numbers to floats. | |
102 | -:- pred promote(number::in, number::in, float::out, float::out) is det. | |
103 | - | |
104 | -%-----------------------------------------------------------------------------% | |
105 | -% Unifies iff both numbers are the integer functor for the ints | |
106 | -:- pred as_int(number, number, int, int). | |
107 | -:- mode as_int(in, in, out, out) is semidet. | |
108 | -:- mode as_int(di, di, uo, uo) is semidet. | |
109 | -:- mode as_int(out, out, in, in) is det. | |
110 | -:- mode as_int(uo, uo, di, di) is det. | |
111 | -:- mode as_int(in, in, in, in) is semidet. % Implied. | |
112 | - | |
113 | -%-----------------------------------------------------------------------------% | |
114 | -% number_type(NumStr, Num) | |
115 | -:- pred number_type(string::in, number::uo) is semidet. | |
116 | - | |
117 | -%-----------------------------------------------------------------------------% | |
118 | -% Comparison components. | |
119 | -%-----------------------------------------------------------------------------% | |
120 | - | |
121 | -% Result of the builtin comparisons. | |
122 | -:- type cmp_result ---> yes ; no ; error(string). | |
123 | - | |
124 | -%-----------------------------------------------------------------------------% | |
125 | -% Runs the builtin comparison predicate. | |
126 | -:- pred comparison(comparison, element, element, cmp_result). | |
127 | -:- mode comparison(in, in, in, uo) is det. | |
128 | - | |
129 | -%-----------------------------------------------------------------------------% | |
130 | - | |
131 | -:- type cmp_pred == (pred(element, element, cmp_result)). | |
132 | -:- mode cmp_pred == (pred(in, in, uo) is det). | |
133 | -:- inst cmp_pred == (pred(in, in, uo) is det). | |
134 | - | |
135 | -%-----------------------------------------------------------------------------% | |
136 | -% Comparison builtins. These are aggressively inlined by the compilation | |
137 | -% phase, so they must be exported to the runtime. | |
138 | -:- pred builtin_eq `with_type` cmp_pred `with_inst` cmp_pred. | |
139 | -:- pred builtin_ne `with_type` cmp_pred `with_inst` cmp_pred. | |
140 | -:- pred builtin_lt `with_type` cmp_pred `with_inst` cmp_pred. | |
141 | -:- pred builtin_gt `with_type` cmp_pred `with_inst` cmp_pred. | |
142 | -:- pred builtin_le `with_type` cmp_pred `with_inst` cmp_pred. | |
143 | -:- pred builtin_ge `with_type` cmp_pred `with_inst` cmp_pred. | |
144 | - | |
145 | -%-----------------------------------------------------------------------------% | |
146 | - | |
147 | -:- pred builtin_eq_bind `with_type` execute_pred `with_inst` execute_pred. | |
148 | -:- pred builtin_ne_bind `with_type` execute_pred `with_inst` execute_pred. | |
149 | -:- pred builtin_lt_bind `with_type` execute_pred `with_inst` execute_pred. | |
150 | -:- pred builtin_gt_bind `with_type` execute_pred `with_inst` execute_pred. | |
151 | -:- pred builtin_le_bind `with_type` execute_pred `with_inst` execute_pred. | |
152 | -:- pred builtin_ge_bind `with_type` execute_pred `with_inst` execute_pred. | |
153 | - | |
154 | -%-----------------------------------------------------------------------------% | |
155 | -% Arithmetic components. | |
156 | -%-----------------------------------------------------------------------------% | |
157 | - | |
158 | -:- pred builtin_plus_bind `with_type` execute_pred `with_inst` execute_pred. | |
159 | -:- pred builtin_minus_bind `with_type` execute_pred `with_inst` execute_pred. | |
160 | -:- pred builtin_times_bind `with_type` execute_pred `with_inst` execute_pred. | |
161 | -:- pred builtin_divide_bind `with_type` execute_pred `with_inst` execute_pred. | |
162 | - | |
163 | -%-----------------------------------------------------------------------------% | |
164 | -% Define components. | |
165 | -%-----------------------------------------------------------------------------% | |
166 | - | |
167 | -:- pred builtin_let_bind `with_type` execute_pred `with_inst` execute_pred. | |
168 | -:- pred builtin_def_bind `with_type` execute_pred `with_inst` execute_pred. | |
169 | -:- pred builtin_fn_bind `with_type` execute_pred `with_inst` execute_pred. | |
170 | - | |
171 | -%=============================================================================% | |
172 | -:- implementation. | |
173 | -%=============================================================================% | |
174 | - | |
175 | -:- use_module char. | |
176 | -:- use_module exception. | |
177 | - | |
178 | -:- include_module tl_runtime.builtin.comparison. | |
179 | -:- import_module tl_runtime.builtin.comparison. | |
180 | - | |
181 | -:- include_module tl_runtime.builtin.arithmetic. | |
182 | -:- import_module tl_runtime.builtin.arithmetic. | |
183 | - | |
184 | -%-----------------------------------------------------------------------------% | |
185 | - | |
186 | -:- pragma inline(comparison/4). | |
187 | -:- pragma inline(builtin_op_tag/2). | |
188 | -:- pragma inline(builtin_op_enum/2). | |
189 | - | |
190 | -%-----------------------------------------------------------------------------% | |
191 | - | |
192 | -:- pragma inline(comparison/4). | |
193 | -:- pragma inline(builtin_eq/3). | |
194 | -:- pragma inline(builtin_lt/3). | |
195 | -:- pragma inline(builtin_gt/3). | |
196 | -:- pragma inline(builtin_le/3). | |
197 | -:- pragma inline(builtin_ge/3). | |
198 | - | |
199 | -%-----------------------------------------------------------------------------% | |
200 | - | |
201 | -:- instance enum.enum(arithmetic) where [ | |
202 | - ( to_int(E) = I :- builtin_op_enum(arithmetic(E), I) ), | |
203 | - ( from_int(I) = E :- builtin_op_enum(arithmetic(E), I) ) | |
204 | -]. | |
205 | - | |
206 | -%-----------------------------------------------------------------------------% | |
207 | - | |
208 | -:- instance enum.enum(logic) where [ | |
209 | - ( to_int(E) = I :- builtin_op_enum(logic(E), I) ), | |
210 | - ( from_int(I) = E :- builtin_op_enum(logic(E), I) ) | |
211 | -]. | |
212 | - | |
213 | -%-----------------------------------------------------------------------------% | |
214 | - | |
215 | -:- instance enum.enum(comparison) where [ | |
216 | - ( to_int(E) = I :- builtin_op_enum(comparison(E), I) ), | |
217 | - ( from_int(I) = E :- builtin_op_enum(comparison(E), I) ) | |
218 | -]. | |
219 | - | |
220 | -%-----------------------------------------------------------------------------% | |
221 | - | |
222 | -comparison_tag(Cmp, Tag) :- | |
223 | - builtin_op_tag(comparison(Cmp), Tag). | |
224 | - | |
225 | -%-----------------------------------------------------------------------------% | |
226 | - | |
227 | -:- instance enum.enum(define) where [ | |
228 | - ( to_int(E) = I :- builtin_op_enum(define(E), I) ), | |
229 | - ( from_int(I) = E :- builtin_op_enum(define(E), I) ) | |
230 | -]. | |
231 | - | |
232 | -%-----------------------------------------------------------------------------% | |
233 | - | |
234 | -:- instance enum.enum(builtin_op) where [ | |
235 | - ( to_int(E) = I :- builtin_op_enum(E, I) ), | |
236 | - ( from_int(I) = E :- builtin_op_enum(E, I) ) | |
237 | -]. | |
238 | - | |
239 | -%-----------------------------------------------------------------------------% | |
240 | - | |
241 | -builtin_op_enum(arithmetic(plus), 0). | |
242 | -builtin_op_enum(arithmetic(minus), 1). | |
243 | -builtin_op_enum(arithmetic(times), 2). | |
244 | -builtin_op_enum(arithmetic(divide), 3). | |
245 | -builtin_op_enum(logic(int_and), 4). | |
246 | -builtin_op_enum(logic(int_or), 5). | |
247 | -builtin_op_enum(logic(int_xor), 6). | |
248 | -builtin_op_enum(comparison(eq), 7). | |
249 | -builtin_op_enum(comparison(ne), 8). | |
250 | -builtin_op_enum(comparison(lt), 9). | |
251 | -builtin_op_enum(comparison(gt), 10). | |
252 | -builtin_op_enum(comparison(le), 11). | |
253 | -builtin_op_enum(comparison(ge), 12). | |
254 | -builtin_op_enum(define(def), 13). | |
255 | -builtin_op_enum(define(let), 14). | |
256 | -builtin_op_enum(define(fn), 15). | |
257 | - | |
258 | -%-----------------------------------------------------------------------------% | |
259 | - | |
260 | -builtin_op_tag(arithmetic(plus), "+"). | |
261 | -builtin_op_tag(arithmetic(minus), "-"). | |
262 | -builtin_op_tag(arithmetic(times), "*"). | |
263 | -builtin_op_tag(arithmetic(divide), "/"). | |
264 | -builtin_op_tag(logic(int_and), "&"). | |
265 | -builtin_op_tag(logic(int_or), "|"). | |
266 | -builtin_op_tag(logic(int_xor), "^"). | |
267 | -builtin_op_tag(comparison(eq), "="). | |
268 | -builtin_op_tag(comparison(ne), "!"). | |
269 | -builtin_op_tag(comparison(lt), "<"). | |
270 | -builtin_op_tag(comparison(gt), ">"). | |
271 | -builtin_op_tag(comparison(le), "<="). | |
272 | -builtin_op_tag(comparison(ge), ">="). | |
273 | -builtin_op_tag(define(def), "def"). | |
274 | -builtin_op_tag(define(let), "let"). | |
275 | -builtin_op_tag(define(fn), "fn"). | |
276 | - | |
277 | -%-----------------------------------------------------------------------------% | |
278 | - | |
279 | -comparison(eq, E1, E2, Result) :- builtin_eq(E1, E2, Result). | |
280 | -comparison(ne, E1, E2, Result) :- builtin_ne(E1, E2, Result). | |
281 | -comparison(lt, E1, E2, Result) :- builtin_lt(E1, E2, Result). | |
282 | -comparison(gt, E1, E2, Result) :- builtin_gt(E1, E2, Result). | |
283 | -comparison(le, E1, E2, Result) :- builtin_le(E1, E2, Result). | |
284 | -comparison(ge, E1, E2, Result) :- builtin_ge(E1, E2, Result). | |
285 | - | |
286 | -%-----------------------------------------------------------------------------% | |
287 | - | |
288 | -promote(float(A), float(B), A, B). | |
289 | -promote(int(A), float(B), int_to_float(A), B). | |
290 | -promote(float(A), int(B), A, int_to_float(B)). | |
291 | -promote(int(A), int(B), int_to_float(A), int_to_float(B)). | |
292 | - | |
293 | -%-----------------------------------------------------------------------------% | |
294 | - | |
295 | -as_int(int(A), int(B), A, B). | |
296 | - | |
297 | -%-----------------------------------------------------------------------------% | |
298 | - | |
299 | -:- pred digit_or_dot(character::in) is semidet. | |
300 | -digit_or_dot(C) :- | |
301 | - ( not C = ('.') ) => char.is_digit(C). | |
302 | - | |
303 | -%-----------------------------------------------------------------------------% | |
304 | - | |
305 | -number_type(In, Out) :- | |
306 | - ( if | |
307 | - string.all_match(char.is_digit, In) | |
308 | - then | |
309 | - string.to_int(In, Int), | |
310 | - builtin__copy(Int, UniqInt), | |
311 | - Out = int(UniqInt) | |
312 | - else if | |
313 | - string.all_match(digit_or_dot, In) | |
314 | - then | |
315 | - string.to_float(In, Float), | |
316 | - builtin__copy(Float, UniqFloat), | |
317 | - Out = float(UniqFloat) | |
318 | - else | |
319 | - string.remove_prefix("0x", In, InP), | |
320 | - string.all_match(char.is_hex_digit, InP), | |
321 | - string.base_string_to_int(16, InP, Int), | |
322 | - builtin__copy(Int, UniqInt), | |
323 | - Out = int(UniqInt) | |
324 | - ). | |
325 | - | |
326 | -%-----------------------------------------------------------------------------% | |
327 | - | |
328 | -builtin_eq(A, B, Result) :- ( A = B -> Result = yes ; Result = no ). | |
329 | - | |
330 | -builtin_ne(A, B, Result) :- ( A = B -> Result = no ; Result = yes ). | |
331 | - | |
332 | -builtin_lt(list(_), list(_), error("Error: `lt/2` -> test two lists")). | |
333 | -builtin_lt(atom(_), list(_), error("Error: `lt/2` -> test atom and list")). | |
334 | -builtin_lt(list(_), atom(_), error("Error: `lt/2` -> test list and atom")). | |
335 | -builtin_lt(atom(A), atom(B), Result) :- | |
336 | - ( atom_compare(A, B, (<)) -> Result = yes ; Result = no ). | |
337 | - | |
338 | -builtin_gt(list(_), list(_), error("Error: `gt/2` -> test two lists")). | |
339 | -builtin_gt(atom(_), list(_), error("Error: `gt/2` -> test atom and list")). | |
340 | -builtin_gt(list(_), atom(_), error("Error: `gt/2` -> test list and atom")). | |
341 | -builtin_gt(atom(A), atom(B), Result) :- | |
342 | - ( atom_compare(A, B, (>)) -> Result = yes ; Result = no ). | |
343 | - | |
344 | -builtin_le(list(_), list(_), error("Error: `le/2` -> test two lists")). | |
345 | -builtin_le(atom(_), list(_), error("Error: `le/2` -> test atom and list")). | |
346 | -builtin_le(list(_), atom(_), error("Error: `le/2` -> test list and atom")). | |
347 | -builtin_le(atom(A), atom(B), Result) :- | |
348 | - ( atom_compare(A, B, (>)) -> Result = no ; Result = yes ). | |
349 | - | |
350 | -builtin_ge(list(_), list(_), error("Error: `ge/2` -> test two lists")). | |
351 | -builtin_ge(atom(_), list(_), error("Error: `ge/2` -> test atom and list")). | |
352 | -builtin_ge(list(_), atom(_), error("Error: `ge/2` -> test list and atom")). | |
353 | -builtin_ge(atom(A), atom(B), Result) :- | |
354 | - ( atom_compare(A, B, (<)) -> Result = no ; Result = yes ). | |
355 | - | |
356 | -%-----------------------------------------------------------------------------% | |
357 | - | |
358 | -builtin_eq_bind(E, R, !RT) :- builtin_comparison_bind(builtin_eq, E, R, !RT). | |
359 | -builtin_ne_bind(E, R, !RT) :- builtin_comparison_bind(builtin_ne, E, R, !RT). | |
360 | -builtin_lt_bind(E, R, !RT) :- builtin_comparison_bind(builtin_lt, E, R, !RT). | |
361 | -builtin_gt_bind(E, R, !RT) :- builtin_comparison_bind(builtin_gt, E, R, !RT). | |
362 | -builtin_le_bind(E, R, !RT) :- builtin_comparison_bind(builtin_le, E, R, !RT). | |
363 | -builtin_ge_bind(E, R, !RT) :- builtin_comparison_bind(builtin_ge, E, R, !RT). | |
364 | - | |
365 | -%-----------------------------------------------------------------------------% | |
366 | - | |
367 | -builtin_plus_bind(E, R, !RT) :- builtin_arithmetic_bind(builtin_plus, plus, E, R). | |
368 | -builtin_minus_bind(E, R, !RT) :- builtin_arithmetic_bind(builtin_minus, minus, E, R). | |
369 | -builtin_times_bind(E, R, !RT) :- builtin_arithmetic_bind(builtin_times, times, E, R). | |
370 | -builtin_divide_bind(E, R, !RT) :- builtin_arithmetic_bind(builtin_divide, divide, E, R). | |
371 | - | |
372 | -%-----------------------------------------------------------------------------% | |
373 | -% Used to implement let and def | |
374 | - | |
375 | -%-----------------------------------------------------------------------------% | |
376 | -% Used to parse argument names in fn/3 | |
377 | -:- pred fn_arg(element, string, int, int, maybe.maybe_error, maybe.maybe_error). | |
378 | -:- mode fn_arg(in, out, in, out, di, uo) is det. | |
379 | -%:- mode fn_arg(di, uo, in, out, di, uo) is det. | |
380 | - | |
381 | -fn_arg(_, "", I, inc(I), maybe.error(E), maybe.error(E)). | |
382 | -fn_arg(list(_), "", I, inc(I), maybe.ok, | |
383 | - maybe.error(string.append(string.append( | |
384 | - "Error: `fn/3` -> Arg list element ", | |
385 | - string.from_int(I)), | |
386 | - " is a list"))). | |
387 | -fn_arg(atom(Str), Str, I, inc(I), maybe.ok, maybe.ok). | |
388 | - | |
389 | -%-----------------------------------------------------------------------------% | |
390 | -% Used to implement fn | |
391 | -:- type fn_parse_result == {string, list(string), list(element), int}. | |
392 | -:- pred fn_parse(list.list(element), maybe.maybe_error(fn_parse_result)). | |
393 | -:- mode fn_parse(in, res_uo) is det. | |
394 | - | |
395 | -fn_parse(Element, Result) :- | |
396 | - ( if | |
397 | - Element = [NameElement|[ArgsElement|Body]] | |
398 | - then | |
399 | - ( | |
400 | - NameElement = list(_), | |
401 | - Result = maybe.error("Error: `fn/3` -> arg 1 is a list") | |
402 | - ; | |
403 | - NameElement = atom(Name), | |
404 | - ( | |
405 | - ArgsElement = atom(_), | |
406 | - Result = maybe.error("Error: `fn/3` -> arg 2 is an atom") | |
407 | - ; | |
408 | - ArgsElement = list(Args), | |
409 | - % Validate the arguments, and construct a list of names. | |
410 | - list.map_foldl2(fn_arg, | |
411 | - Args, ArgNames, 0, Arity, maybe.ok, ArgsResult), | |
412 | - ( | |
413 | - ArgsResult = maybe.ok, | |
414 | - Result = maybe.ok({Name, ArgNames, Body, Arity}) | |
415 | - ; | |
416 | - ArgsResult = maybe.error(Error), | |
417 | - Result = maybe.error(Error) | |
418 | - ) | |
419 | - ) | |
420 | - ) | |
421 | - else | |
422 | - exception.throw(exception.software_error( | |
423 | - "Wrong arity in `fn/3` (builtin_bind is probably broken)")) | |
424 | - ). | |
425 | - | |
426 | -%-----------------------------------------------------------------------------% | |
427 | - | |
428 | -builtin_fn_bind(Element, Result, !Runtime) :- | |
429 | - fn_parse(Element, FnResult), | |
430 | - ( | |
431 | - FnResult = maybe.error(Error), | |
432 | - Result = maybe.error(Error) | |
433 | - ; | |
434 | - FnResult = maybe.ok({Name, ArgNames, Body, Arity}), | |
435 | - def_bind(args(Name, Arity), lisp_bind(ArgNames, Body), !Runtime), | |
436 | - Result = maybe.ok(atom(Name)) | |
437 | - ). | |
438 | - | |
439 | -%-----------------------------------------------------------------------------% | |
440 | - | |
441 | -builtin_def_bind(Element, Result, !Runtime) :- | |
442 | - ( if | |
443 | - Element = [NameElement|[Value|[]]] | |
444 | - then | |
445 | - ( | |
446 | - NameElement = atom(Name), | |
447 | - !.Runtime ^ globals = Globals, | |
448 | - !Runtime ^ globals := rbtree.set(Globals, Name, Value), | |
449 | - Result = maybe.ok(Value) | |
450 | - ; | |
451 | - NameElement = list(_), | |
452 | - Result = maybe.error("Error: `def/2` -> arg 1 is a list") | |
453 | - ) | |
454 | - else | |
455 | - exception.throw(exception.software_error( | |
456 | - "Wrong arity in `def/2` (builtin_bind is probably broken)")) | |
457 | - ). | |
458 | - | |
459 | -%-----------------------------------------------------------------------------% | |
460 | - | |
461 | -builtin_let_bind(Element, Result, !Runtime) :- | |
462 | - ( if | |
463 | - Element = [NameElement|[Value|[]]] | |
464 | - then | |
465 | - ( | |
466 | - NameElement = atom(Name), | |
467 | - def_var(Name, Value, !Runtime), | |
468 | - Result = maybe.ok(Value) | |
469 | - ; | |
470 | - NameElement = list(_), | |
471 | - Result = maybe.error("Error: `let/2` -> arg 1 is a list") | |
472 | - ) | |
473 | - else | |
474 | - exception.throw(exception.software_error( | |
475 | - "Wrong arity in `let/2` (builtin_bind is probably broken)")) | |
476 | - ). |
@@ -1,800 +0,0 @@ | ||
1 | -:- module tl_runtime. | |
2 | - | |
3 | -%=============================================================================% | |
4 | -% Turbolisp Runtime. | |
5 | -% This is separate from the Turbolisp module, which provides just an | |
6 | -% S-expression parser. Depending on your inputs, that might be enough :) | |
7 | -% Ideally we would also separate out the execute/reduce components, since you | |
8 | -% usually don't want both. | |
9 | -:- interface. | |
10 | -%=============================================================================% | |
11 | - | |
12 | -:- import_module list. | |
13 | -:- use_module assoc_list. | |
14 | -:- use_module rbtree. | |
15 | -:- use_module maybe. | |
16 | - | |
17 | -:- import_module turbolisp. | |
18 | - | |
19 | -%-----------------------------------------------------------------------------% | |
20 | -% TODO! | |
21 | -:- func nil = element. | |
22 | - | |
23 | -%-----------------------------------------------------------------------------% | |
24 | -% Frames use an assoc list, as they are not expected to have a lot of elements, | |
25 | -% and the extra allocations of a tree would quickly overwhelm the gains in | |
26 | -% lookup speed. | |
27 | -:- type frame ---> | |
28 | - frame(variables::assoc_list.assoc_list(string, element)). | |
29 | - | |
30 | -%-----------------------------------------------------------------------------% | |
31 | - | |
32 | -:- func init_frame = frame. | |
33 | - | |
34 | -%-----------------------------------------------------------------------------% | |
35 | - | |
36 | -:- func init_frame(assoc_list.assoc_list(string, element)) = frame. | |
37 | - | |
38 | -%-----------------------------------------------------------------------------% | |
39 | - | |
40 | -:- type result == maybe.maybe_error(element). | |
41 | - | |
42 | -%-----------------------------------------------------------------------------% | |
43 | - | |
44 | -:- inst maybe_unique_error ---> | |
45 | - maybe.ok(ground) ; | |
46 | - maybe.error(unique). | |
47 | - | |
48 | -:- inst maybe_clobbered_error ---> | |
49 | - maybe.ok(ground) ; | |
50 | - maybe.error(clobbered). | |
51 | - | |
52 | -:- mode res_uo == free >> maybe_unique_error. | |
53 | -:- mode res_di == maybe_unique_error >> maybe_clobbered_error. | |
54 | - | |
55 | -%-----------------------------------------------------------------------------% | |
56 | - | |
57 | -:- type execute_pred == (pred(list.list(element), result, runtime, runtime)). | |
58 | -:- inst execute_pred == (pred(in, res_uo, in, out) is det). | |
59 | -:- mode execute_pred == (pred(in, res_uo, in, out) is det). | |
60 | - | |
61 | -:- type bind ---> | |
62 | - mercury_bind(pred(list.list(element)::in, result::res_uo, runtime::in, runtime::out) is det) ; | |
63 | - lisp_bind(arg_names::list.list(string), body::list.list(element)). | |
64 | - | |
65 | -%-----------------------------------------------------------------------------% | |
66 | - | |
67 | -:- type bind_spec ---> | |
68 | - variadic(string) ; | |
69 | - args(string, int). | |
70 | - | |
71 | -%-----------------------------------------------------------------------------% | |
72 | - | |
73 | -:- type variables == rbtree.rbtree(string, element). | |
74 | - | |
75 | -%-----------------------------------------------------------------------------% | |
76 | - | |
77 | -:- type runtime ---> runtime( | |
78 | - globals::variables, | |
79 | - binds::rbtree.rbtree(bind_spec, bind), | |
80 | - stack_frames::list.list(frame), | |
81 | - pending_io::list.list(string)). | |
82 | - | |
83 | -%-----------------------------------------------------------------------------% | |
84 | - | |
85 | -:- func init = runtime. | |
86 | - | |
87 | -%-----------------------------------------------------------------------------% | |
88 | - | |
89 | -:- pred push_stack_frame(runtime::in, runtime::out) is det. | |
90 | - | |
91 | -%-----------------------------------------------------------------------------% | |
92 | - | |
93 | -:- pred push_stack_frame(assoc_list.assoc_list(string, element)::in, | |
94 | - runtime::in, runtime::out) is det. | |
95 | - | |
96 | -%-----------------------------------------------------------------------------% | |
97 | - | |
98 | -:- pred pop_stack_frame(runtime::in, runtime::out) is det. | |
99 | - | |
100 | -%-----------------------------------------------------------------------------% | |
101 | - | |
102 | -:- pred push_stack_frame_check(int::out, runtime::in, runtime::out) is det. | |
103 | - | |
104 | -%-----------------------------------------------------------------------------% | |
105 | - | |
106 | -:- pred push_stack_frame_check(assoc_list.assoc_list(string, element)::in, | |
107 | - int::out, runtime::in, runtime::out) is det. | |
108 | - | |
109 | -%-----------------------------------------------------------------------------% | |
110 | - | |
111 | -:- pred pop_stack_frame_check(int::in, runtime::in, runtime::out) is det. | |
112 | - | |
113 | -%-----------------------------------------------------------------------------% | |
114 | - | |
115 | -:- pred def_var(string::in, element::in, runtime::in, runtime::out) is det. | |
116 | - | |
117 | -%-----------------------------------------------------------------------------% | |
118 | - | |
119 | -:- pred find_var(list.list(frame), rbtree.rbtree(string, element), string, element). | |
120 | -:- mode find_var(in, in, in, out) is semidet. | |
121 | - | |
122 | -%-----------------------------------------------------------------------------% | |
123 | - | |
124 | -:- pred builtin_bind(bind_spec::in, bind::out) is semidet. | |
125 | - | |
126 | -%-----------------------------------------------------------------------------% | |
127 | - | |
128 | -:- pred def_bind(bind_spec::in, bind::in, runtime::in, runtime::out) is det. | |
129 | - | |
130 | -%-----------------------------------------------------------------------------% | |
131 | - | |
132 | -:- pred find_bind(string, int, rbtree.rbtree(bind_spec, bind), bind). | |
133 | -:- mode find_bind(in, in, in, out) is semidet. | |
134 | - | |
135 | -%-----------------------------------------------------------------------------% | |
136 | -% This is a workaround, as the Mercury compiler gets confused when disjuncting | |
137 | -% on functors which contain predicates as elements in the functor. | |
138 | -:- pred call_bind(bind, list.list(element), result, runtime, runtime). | |
139 | -:- mode call_bind(in, in, res_uo, in, out) is det. | |
140 | - | |
141 | -%-----------------------------------------------------------------------------% | |
142 | - | |
143 | -:- type run_pred1 == (pred(element, result, runtime, runtime)). | |
144 | -:- inst run_pred1 == (pred(in, res_uo, in, out) is det). | |
145 | -:- mode run_pred1 == (pred(in, res_uo, in, out) is det). | |
146 | - | |
147 | -%-----------------------------------------------------------------------------% | |
148 | -% Same as run_pred1, but is suitable for use with list.map_foldl2 | |
149 | -:- type run_pred2 == (pred(element, element, | |
150 | - runtime, runtime, | |
151 | - maybe.maybe_error, maybe.maybe_error)). | |
152 | -:- inst run_pred2 == (pred(in, out, in, out, di, uo) is det). | |
153 | -:- mode run_pred2 == (pred(in, out, in, out, di, uo) is det). | |
154 | - | |
155 | -%-----------------------------------------------------------------------------% | |
156 | -% Same as run_pred1, but is suitable for use with list.map_foldl3 while | |
157 | -% counting elements in the list. | |
158 | -:- type run_pred3 == (pred(element, element, | |
159 | - runtime, runtime, | |
160 | - int, int, | |
161 | - maybe.maybe_error, maybe.maybe_error)). | |
162 | -:- inst run_pred3 == (pred(in, out, in, out, in, out, di, uo) is det). | |
163 | -:- mode run_pred3 == (pred(in, out, in, out, in, out, di, uo) is det). | |
164 | - | |
165 | -%-----------------------------------------------------------------------------% | |
166 | - | |
167 | -:- pred reduce `with_type` run_pred1 `with_inst` run_pred1. | |
168 | -:- pred reduce `with_type` run_pred2 `with_inst` run_pred2. | |
169 | -:- pred reduce `with_type` run_pred3 `with_inst` run_pred3. | |
170 | - | |
171 | -%-----------------------------------------------------------------------------% | |
172 | - | |
173 | -:- pred execute `with_type` run_pred1 `with_inst` run_pred1. | |
174 | -:- pred execute `with_type` run_pred2 `with_inst` run_pred2. | |
175 | -:- pred execute `with_type` run_pred3 `with_inst` run_pred3. | |
176 | - | |
177 | -%=============================================================================% | |
178 | -:- implementation. | |
179 | -%=============================================================================% | |
180 | - | |
181 | -:- use_module exception. | |
182 | -:- use_module int. | |
183 | -:- use_module string. | |
184 | -:- use_module pair. | |
185 | - | |
186 | -:- include_module tl_runtime.builtin. | |
187 | -:- use_module tl_runtime.builtin. | |
188 | - | |
189 | -%-----------------------------------------------------------------------------% | |
190 | - | |
191 | -nil = list([]). | |
192 | - | |
193 | -%-----------------------------------------------------------------------------% | |
194 | -% Used for the optimized C routines. | |
195 | -:- pragma foreign_decl("C", " | |
196 | -#ifdef _MSC_VER | |
197 | - | |
198 | -#define TL_YIELD_ARITY(ARITY, DST, OUT) \\ | |
199 | - _ltoa_s((ARITY), (OUT), 77, 10); \\ | |
200 | - (OUT)[76] = 0; \\ | |
201 | - const MR_Integer DST = strnlen_s((OUT), 77) | |
202 | - | |
203 | -#else | |
204 | - | |
205 | -#define TL_YIELD_ARITY(ARITY, DST, OUT) \\ | |
206 | - const MR_Integer DST = sprintf((OUT), ""%i"", (ARITY)) | |
207 | - | |
208 | -#endif | |
209 | - | |
210 | -#define TL_YIELD_FUNC_NAME(NAME, NAME_LEN, ARITY, END, OUT) do { \\ | |
211 | - (OUT)[0] = '`'; \\ | |
212 | - memcpy((OUT)+1, Name, (NAME_LEN)); \\ | |
213 | - (OUT)[(NAME_LEN)+1] = '/'; \\ | |
214 | - { \\ | |
215 | - const MR_Integer arity_start = (NAME_LEN)+2; \\ | |
216 | - TL_YIELD_ARITY((ARITY), ZZ_end, (OUT) + arity_start) + arity_start; \\ | |
217 | - (OUT)[ZZ_end] = '`'; \\ | |
218 | - (END) = ZZ_end+1; \\ | |
219 | - } \\ | |
220 | - \\ | |
221 | -}while(0) | |
222 | - | |
223 | -"). | |
224 | - | |
225 | -%-----------------------------------------------------------------------------% | |
226 | - | |
227 | -:- func yield_func_name(string::in, int::in) = (string::uo) is det. | |
228 | -yield_func_name(Name, Arity) = string.append(TickFuncArity, "`") :- | |
229 | - string.first_char(ArityString, ('/'), string.from_int(Arity)), | |
230 | - string.first_char(TickFuncName, ('`'), Name), | |
231 | - string.append(TickFuncName, ArityString, TickFuncArity). | |
232 | - | |
233 | -% Optimized C version. | |
234 | -:- pragma foreign_proc("C", yield_func_name(Name::in, Arity::in) = (Out::uo), | |
235 | - [promise_pure, thread_safe, will_not_call_mercury, will_not_modify_trail, | |
236 | - does_not_affect_liveness, may_duplicate], | |
237 | - " | |
238 | - const MR_Integer name_len = strlen(Name); | |
239 | - MR_allocate_aligned_string_msg(Out, name_len + 80, MR_ALLOC_ID); | |
240 | - MR_Integer end; | |
241 | - TL_YIELD_FUNC_NAME(Name, name_len, Arity, end, Out); | |
242 | - Out[end] = 0; | |
243 | - "). | |
244 | - | |
245 | -%-----------------------------------------------------------------------------% | |
246 | - | |
247 | -:- func func_error(string::in, int::in, string::in) = (string::uo) is det. | |
248 | -func_error(Name, Arity, Error) = | |
249 | - string.append(func_error_prefix(Name, Arity), Error). | |
250 | - | |
251 | -%-----------------------------------------------------------------------------% | |
252 | - | |
253 | -:- func func_error_prefix(string::in, int::in) = (string::uo) is det. | |
254 | -func_error_prefix(Name, Arity) = | |
255 | - string.append( | |
256 | - string.append( | |
257 | - "Error ", | |
258 | - yield_func_name(Name, Arity)), | |
259 | - " -> "). | |
260 | - | |
261 | -% Optimized C version. | |
262 | -:- pragma foreign_proc("C", func_error(Name::in, Arity::in, Error::in) = (Out::uo), | |
263 | - [promise_pure, thread_safe, will_not_call_mercury, will_not_modify_trail, | |
264 | - does_not_affect_liveness, may_duplicate], | |
265 | - " | |
266 | - const char head[] = {'E', 'r', 'r', 'o', 'r', ':', ' '}; | |
267 | - const char tail[] = {' ', '-', '>', ' '}; | |
268 | - const MR_Integer name_len = strlen(Name); | |
269 | - const MR_Integer error_len = strlen(Error); | |
270 | - MR_allocate_aligned_string_msg(Out, name_len + error_len + 90, MR_ALLOC_ID); | |
271 | - MR_Integer end; | |
272 | - memcpy(Out, head, sizeof(head)); | |
273 | - TL_YIELD_FUNC_NAME(Name, name_len, Arity, end, Out+sizeof(head)); | |
274 | - memcpy(Out+sizeof(head)+end, tail, sizeof(tail)); | |
275 | - memcpy(Out+sizeof(head)+sizeof(tail)+end, Error, error_len+1); | |
276 | - "). | |
277 | - | |
278 | -%-----------------------------------------------------------------------------% | |
279 | - | |
280 | -:- func list_index_error(int::in, int::in) = (string::uo) is det. | |
281 | -list_index_error(At, Length) = Result :- | |
282 | - string.append("`at` -> index of '", string.from_int(At), Err0), | |
283 | - string.append(Err0, "' out of bounds for list of length '", Err1), | |
284 | - string.append(Err1, string.from_int(Length), Err2), | |
285 | - string.append(Err2, "'", Result). | |
286 | - | |
287 | -% Optimized C version. | |
288 | -:- pragma foreign_proc("C", list_index_error(At::in, Length::in) = (Out::uo), | |
289 | - [promise_pure, thread_safe, will_not_call_mercury, will_not_modify_trail, | |
290 | - does_not_affect_liveness, may_duplicate], | |
291 | - " | |
292 | - MR_allocate_aligned_string_msg(Out, 160, MR_ALLOC_ID); | |
293 | - snprintf(Out, 159, | |
294 | - ""`at` -> index of '%i' out of bounds for list of length '%i'"", | |
295 | - At, Length); | |
296 | - Out[159] = 0; | |
297 | - "). | |
298 | - | |
299 | -%-----------------------------------------------------------------------------% | |
300 | - | |
301 | -init_frame(Variables) = frame(Variables). | |
302 | -init_frame = init_frame([]). | |
303 | - | |
304 | -%-----------------------------------------------------------------------------% | |
305 | - | |
306 | -init = runtime(rbtree.init, rbtree.init, [], []). | |
307 | - | |
308 | -%-----------------------------------------------------------------------------% | |
309 | - | |
310 | -push_stack_frame(Variables, runtime(G, B, Frames, PIO), | |
311 | - runtime(G, B, [init_frame(Variables)|Frames], PIO)). | |
312 | - | |
313 | -%-----------------------------------------------------------------------------% | |
314 | - | |
315 | -push_stack_frame(runtime(G, B, Frames, PIO), | |
316 | - runtime(G, B, [init_frame|Frames], PIO)). | |
317 | - | |
318 | -%-----------------------------------------------------------------------------% | |
319 | - | |
320 | -pop_stack_frame(runtime(G, B, [_Head|Frames], PIO), | |
321 | - runtime(G, B, Frames, PIO)) :- | |
322 | - % trace [io(!IO)] ( | |
323 | - % rbtree.keys(Head ^ variables, Keys), | |
324 | - % io.write_string("Pop losing ", !IO), | |
325 | - % io.write_int(list.length(Keys), !IO), io.nl(!IO), | |
326 | - % list.foldl( | |
327 | - % (pred(Str::in, I::di, O::uo) is semidet :- | |
328 | - % io.write_string(Str, I, M), io.nl(M, O)), | |
329 | - % Keys, !IO) | |
330 | - % ), | |
331 | - true. | |
332 | - | |
333 | -pop_stack_frame(runtime(_, _, [], _), _) :- | |
334 | - exception.throw(exception.software_error("Stack underflow")). | |
335 | - | |
336 | -%-----------------------------------------------------------------------------% | |
337 | - | |
338 | -push_stack_frame_check(Check, !Runtime) :- | |
339 | - push_stack_frame(!Runtime), | |
340 | - list.length(!.Runtime ^ stack_frames, Check). | |
341 | - | |
342 | -%-----------------------------------------------------------------------------% | |
343 | - | |
344 | -push_stack_frame_check(Variables, Check, !Runtime) :- | |
345 | - push_stack_frame(Variables, !Runtime), | |
346 | - list.length(!.Runtime ^ stack_frames, Check). | |
347 | - | |
348 | -%-----------------------------------------------------------------------------% | |
349 | - | |
350 | -pop_stack_frame_check(Check, !Runtime) :- | |
351 | - ( if | |
352 | - list.length(!.Runtime ^ stack_frames, Check) | |
353 | - then | |
354 | - pop_stack_frame(!Runtime) | |
355 | - else | |
356 | - exception.throw(exception.software_error("Stack mismatch")) | |
357 | - ). | |
358 | - | |
359 | -%-----------------------------------------------------------------------------% | |
360 | - | |
361 | -def_var(Name, Value, !Runtime) :- | |
362 | - !.Runtime ^ stack_frames = StackFrames, | |
363 | - ( | |
364 | - StackFrames = [frame(In)|Tail], | |
365 | - | |
366 | - ( assoc_list.remove(In, Name, _, V) -> Out = V ; Out = In ), | |
367 | - | |
368 | - !Runtime ^ stack_frames := [frame([pair.pair(Name, Value)|Out])|Tail] | |
369 | - ; | |
370 | - StackFrames = [], | |
371 | - | |
372 | - !.Runtime ^ globals = In, | |
373 | - rbtree.set(Name, Value, In, Out), | |
374 | - !Runtime ^ globals := Out | |
375 | - ). | |
376 | - | |
377 | -%-----------------------------------------------------------------------------% | |
378 | - | |
379 | -find_var([], Globals, Name, Value) :- rbtree.search(Globals, Name, Value). | |
380 | -find_var([frame(Head)|Tail], Globals, Name, Value) :- | |
381 | - ( if | |
382 | - assoc_list.search(Head, Name, SemiValue) | |
383 | - then | |
384 | - Value = SemiValue | |
385 | - else | |
386 | - find_var(Tail, Globals, Name, Value) | |
387 | - ). | |
388 | - | |
389 | -%-----------------------------------------------------------------------------% | |
390 | - | |
391 | -builtin_bind(args("=", 4), mercury_bind(tl_runtime__builtin__builtin_eq_bind)). | |
392 | -builtin_bind(args("!", 4), mercury_bind(tl_runtime__builtin__builtin_ne_bind)). | |
393 | -builtin_bind(args("<", 4), mercury_bind(tl_runtime__builtin__builtin_lt_bind)). | |
394 | -builtin_bind(args(">", 4), mercury_bind(tl_runtime__builtin__builtin_gt_bind)). | |
395 | -builtin_bind(args("<=", 4), mercury_bind(tl_runtime__builtin__builtin_le_bind)). | |
396 | -builtin_bind(args(">=", 4), mercury_bind(tl_runtime__builtin__builtin_ge_bind)). | |
397 | - | |
398 | -builtin_bind(args("+", 2), mercury_bind(tl_runtime__builtin__builtin_plus_bind)). | |
399 | -builtin_bind(args("-", 2), mercury_bind(tl_runtime__builtin__builtin_minus_bind)). | |
400 | -builtin_bind(args("*", 2), mercury_bind(tl_runtime__builtin__builtin_times_bind)). | |
401 | -builtin_bind(args("/", 2), mercury_bind(tl_runtime__builtin__builtin_divide_bind)). | |
402 | - | |
403 | -builtin_bind(args("fn", 3), mercury_bind(tl_runtime__builtin__builtin_fn_bind)). | |
404 | - | |
405 | -%-----------------------------------------------------------------------------% | |
406 | - | |
407 | -def_bind(BindSpec, Bind, !Runtime) :- | |
408 | - Binds = !.Runtime ^ binds, | |
409 | - !Runtime ^ binds := rbtree.set(Binds, BindSpec, Bind). | |
410 | - | |
411 | -%-----------------------------------------------------------------------------% | |
412 | - | |
413 | -find_bind(Name, Arity, Tree, Out) :- | |
414 | - % Try for set args before trying for variadic args. | |
415 | - Args = args(Name, Arity), Variadic = variadic(Name), | |
416 | - ( if | |
417 | - rbtree.search(Tree, Args, Bind) | |
418 | - then | |
419 | - Out = Bind | |
420 | - else if | |
421 | - builtin_bind(Args, Bind) | |
422 | - then | |
423 | - Out = Bind | |
424 | - else if | |
425 | - rbtree.search(Tree, Variadic, Bind) | |
426 | - then | |
427 | - Out = Bind | |
428 | - else | |
429 | - builtin_bind(Variadic, Out) | |
430 | - ). | |
431 | - | |
432 | -%-----------------------------------------------------------------------------% | |
433 | - | |
434 | -call_bind(mercury_bind(Pred), Args, Result, !Runtime) :- | |
435 | - call(Pred, Args, Result:result, !Runtime). | |
436 | - | |
437 | -call_bind(lisp_bind(ArgNames, Body), Args, Result, !Runtime) :- | |
438 | - | |
439 | - assoc_list.from_corresponding_lists(ArgNames, Args, Variables), | |
440 | - | |
441 | - % This is needed both for a func call, and just to yield the reduced | |
442 | - % version of this list if it is not executable. | |
443 | - push_stack_frame_check(Variables, Check, !Runtime), | |
444 | - % trace [io(!IO)] ( io.write_string("Push stack from in call_bind\n", !IO) ), | |
445 | - | |
446 | - list.map_foldl2(execute, Body, Values, !Runtime, maybe.ok, CallResult), | |
447 | - | |
448 | - % trace [io(!IO)] ( io.write_string("Pop stack from in call_bind\n", !IO) ), | |
449 | - pop_stack_frame_check(Check, !Runtime), | |
450 | - | |
451 | - ( | |
452 | - CallResult = maybe.ok, | |
453 | - ( if | |
454 | - list.last(Values, Last) | |
455 | - then | |
456 | - Result = maybe.ok(Last) | |
457 | - else | |
458 | - Result = maybe.ok(nil) | |
459 | - ) | |
460 | - ; | |
461 | - CallResult = maybe.error(Error), | |
462 | - Result = maybe.error(Error) | |
463 | - ). | |
464 | - | |
465 | -%-----------------------------------------------------------------------------% | |
466 | -% Result of preprocessing. | |
467 | -% Comparison is a special case because of laziness. | |
468 | -:- type preprocess_result ---> | |
469 | - reduced(element) ; % Result is fully reduced. | |
470 | - execute(string, list(element), preprocess_arity::int) ; % Result is a call. | |
471 | - comparison(tl_runtime.builtin.comparison, element, element, list(element)). | |
472 | - | |
473 | -%-----------------------------------------------------------------------------% | |
474 | -% Performs preprocessing logic which is shared between reduce and execute. | |
475 | -:- pred preprocess(run_pred3, element, maybe.maybe_error(preprocess_result), runtime, runtime). | |
476 | -:- mode preprocess(run_pred3, in, res_uo, in, out) is det. | |
477 | - | |
478 | -% Pass atoms through unchanged. | |
479 | -preprocess(_, atom(Str), maybe.ok(reduced(atom(Str))), !Runtime). | |
480 | - | |
481 | -% Empty list, nothing to do. | |
482 | -preprocess(_, list([]), maybe.ok(reduced(list([]))), !Runtime). | |
483 | - | |
484 | -% Do a maybe-reduce on a list with a list as its head. | |
485 | -preprocess(Pred, list(ElementsRaw @ [list(_)|_]), Result, !Runtime) :- | |
486 | - list.map_foldl3(Pred, ElementsRaw, Elements, | |
487 | - !Runtime, | |
488 | - 0, ArgNum, | |
489 | - maybe.ok, ElementsError), | |
490 | - ( | |
491 | - ElementsError = maybe.error(Error), | |
492 | - Result = maybe.error(Error) | |
493 | - ; | |
494 | - ElementsError = maybe.ok, | |
495 | - ( | |
496 | - ( Elements = [] ; Elements = [list(_)|_] ), | |
497 | - Result = maybe.ok(reduced(list(Elements))) | |
498 | - ; | |
499 | - Elements = [atom(Tag)|Tail], | |
500 | - Result = maybe.ok(execute(Tag, Tail, ArgNum)) | |
501 | - ) | |
502 | - ). | |
503 | - | |
504 | -% Report a call for a list consisting of just an atom. | |
505 | -preprocess(_, list([atom(Tag)|[]]), maybe.ok(execute(Tag, [], 0)), !Runtime). | |
506 | - | |
507 | -% Do a maybe-reduce on a list with an atom as its head. | |
508 | -preprocess(Pred, In @ list([atom(Tag)|Tail]), Result, !Runtime) :- | |
509 | - Tail = [_|_], | |
510 | - ( if | |
511 | - Tag = "." | |
512 | - then | |
513 | - % Escaped list. | |
514 | - Result = maybe.ok(reduced(In)) | |
515 | - else if | |
516 | - % Special handling for comparisons, since they must be laziy evaluated. | |
517 | - tl_runtime.builtin.builtin_op_tag(Op, Tag), | |
518 | - tl_runtime.builtin.comparison(Cmp) = Op | |
519 | - then | |
520 | - % Sort of punt on argument lists less than size 2. | |
521 | - % These will be errors later anyway. | |
522 | - ( | |
523 | - Tail = [_|[]], | |
524 | - Result = maybe.ok(execute(Tag, Tail, 1)) | |
525 | - ; | |
526 | - [E1|[E2|Tail2]] = Tail, | |
527 | - Pred(E1, R1, !Runtime, 0, _, maybe.ok, ResultMid), | |
528 | - Pred(E2, R2, !Runtime, 0, _, ResultMid, PredResult), | |
529 | - ( | |
530 | - PredResult = maybe.ok, | |
531 | - Result = maybe.ok(comparison(Cmp, R1, R2, Tail2)) | |
532 | - ; | |
533 | - PredResult = maybe.error(Error), | |
534 | - Result = maybe.error(Error) | |
535 | - ) | |
536 | - ) | |
537 | - else | |
538 | - list.map_foldl3(Pred, Tail, ReducedTail, | |
539 | - !Runtime, | |
540 | - 0, ArgNum, | |
541 | - maybe.ok, ElementsError), | |
542 | - ( | |
543 | - ElementsError = maybe.error(Error), | |
544 | - Result = maybe.error(Error) | |
545 | - ; | |
546 | - ElementsError = maybe.ok, | |
547 | - Result = maybe.ok(execute(Tag, ReducedTail, ArgNum)) | |
548 | - ) | |
549 | - ). | |
550 | - | |
551 | -%-----------------------------------------------------------------------------% | |
552 | - | |
553 | -:- pred is_atom(element). | |
554 | -:- mode is_atom(in) is semidet. | |
555 | - | |
556 | -is_atom(atom(_)). | |
557 | - | |
558 | -%-----------------------------------------------------------------------------% | |
559 | - | |
560 | -:- pred is_atom_or_list_of_atoms(element). | |
561 | -:- mode is_atom_or_list_of_atoms(in) is semidet. | |
562 | - | |
563 | -is_atom_or_list_of_atoms(atom(_)). | |
564 | -is_atom_or_list_of_atoms(list([])). | |
565 | -is_atom_or_list_of_atoms(list(List @ [_|_])) :- list.all_true(is_atom, List). | |
566 | - | |
567 | -%-----------------------------------------------------------------------------% | |
568 | -% Reduces an element. This is mainly different in how it handles results from | |
569 | -% binds, and how it handles comparisons. | |
570 | -reduce(Element, Result, !Runtime) :- | |
571 | - preprocess(reduce, Element, PreprocessResult, !Runtime), | |
572 | - ( | |
573 | - PreprocessResult = maybe.error(Error), | |
574 | - Result = maybe.error(Error) | |
575 | - ; | |
576 | - PreprocessResult = maybe.ok(PreprocessOutput), | |
577 | - ( | |
578 | - PreprocessOutput = reduced(Reduced), | |
579 | - Result = maybe.ok(Reduced) | |
580 | - ; | |
581 | - PreprocessOutput = comparison(Cmp, A, B, Tail), | |
582 | - | |
583 | - % Try to inline the result of the comparison, if possible. | |
584 | - % This also allows us to not even compile the side which was not used. | |
585 | - tl_runtime.builtin.comparison_tag(Cmp, Tag), | |
586 | - FallbackResult = maybe.ok(list([atom(Tag)|Tail])), | |
587 | - ( | |
588 | - % Incorrect tail length for comparison builtin. Good luck kid. | |
589 | - ( Tail = [] ; Tail = [_|[]] ; Tail = [_|[_|[_|_]]] ), | |
590 | - Result = FallbackResult | |
591 | - ; | |
592 | - Tail = [Y|[N|[]]], | |
593 | - tl_runtime.builtin.comparison(Cmp, A, B, CmpResult), | |
594 | - ( | |
595 | - CmpResult = tl_runtime.builtin.error(_), | |
596 | - Result = FallbackResult | |
597 | - ; | |
598 | - ( | |
599 | - CmpResult = tl_runtime.builtin.yes, Choice = Y | |
600 | - ; | |
601 | - CmpResult = tl_runtime.builtin.no, Choice = N | |
602 | - ), | |
603 | - | |
604 | - % It should be safe to reduce the result. EIther it is known at | |
605 | - % compile-time, or the comparison will have failed to yield a | |
606 | - % result and we won't be in this arm. | |
607 | - reduce(Choice, ChoiceResult, !Runtime), | |
608 | - ( | |
609 | - ChoiceResult = maybe.error(_), | |
610 | - Result = FallbackResult | |
611 | - ; | |
612 | - ChoiceResult = maybe.ok(_), | |
613 | - Result = ChoiceResult | |
614 | - ) | |
615 | - ) | |
616 | - ) | |
617 | - ; | |
618 | - PreprocessOutput = execute(Tag, Tail, Arity), | |
619 | - ( if | |
620 | - % Do NOT use the results of define ops during reduction. | |
621 | - % For let's, the existence of the let will be erased by popping | |
622 | - % the stack frame, and the value will not show up later in the | |
623 | - % actual execution. | |
624 | - % For fn's def's, this would erase the definition entirely as | |
625 | - % we may lose the entire runtime between reduction and | |
626 | - % execution (as in copmilation model). | |
627 | - % We can still retain the reduced tail, however. | |
628 | - % It is also useful to actually bind the value anyway, since | |
629 | - % this lets us inline functions and variables. | |
630 | - % See below for inlining determination. | |
631 | - tl_runtime__builtin__builtin_op_tag( | |
632 | - tl_runtime__builtin__define(Op), Tag) | |
633 | - then | |
634 | - ( | |
635 | - Op = tl_runtime__builtin__fn, | |
636 | - % Super rudimentary inline test. | |
637 | - % Only inline fn if we have a body consisting of less than | |
638 | - % 64 elements, and all the elements are either atoms or a | |
639 | - % list of atoms (as opposed to a list with list elements). | |
640 | - ( if | |
641 | - list.index0(Tail, 1, Body), | |
642 | - ( | |
643 | - Body = atom(_) | |
644 | - ; | |
645 | - Body = list(List), | |
646 | - builtin__compare((<), list.length(List), 64), | |
647 | - list.all_true(is_atom_or_list_of_atoms, List) | |
648 | - ) | |
649 | - then | |
650 | - tl_runtime__builtin__builtin_fn_bind(Tail, _, !Runtime) | |
651 | - else | |
652 | - true | |
653 | - ) | |
654 | - ; | |
655 | - Op = tl_runtime__builtin__let | |
656 | - ; | |
657 | - Op = tl_runtime__builtin__def | |
658 | - ), | |
659 | - Result = maybe.ok(list([atom(Tag)|Tail])) | |
660 | - else if | |
661 | - find_bind(Tag, Arity, !.Runtime ^ binds, Bind) | |
662 | - then | |
663 | - call_bind(Bind, Tail, CallResult, !Runtime), | |
664 | - | |
665 | - ( | |
666 | - CallResult = maybe.error(Error), | |
667 | - Result = maybe.error(func_error(Tag, Arity, Error)) | |
668 | - ; | |
669 | - CallResult = maybe.ok(_), | |
670 | - Result = CallResult | |
671 | - ) | |
672 | - else | |
673 | - Result = maybe.ok(list([atom(Tag)|Tail])) | |
674 | - ) | |
675 | - ) | |
676 | - ). | |
677 | - | |
678 | -%-----------------------------------------------------------------------------% | |
679 | - | |
680 | -reduce(!E, !R, maybe.error(E), maybe.error(E)). | |
681 | -reduce(In, Out, !Runtime, maybe.ok, Result) :- | |
682 | - reduce(In, OutResult, !Runtime), | |
683 | - ( | |
684 | - OutResult = maybe.error(Error), | |
685 | - Result = maybe.error(Error), | |
686 | - In = Out | |
687 | - ; | |
688 | - OutResult = maybe.ok(Out), | |
689 | - Result = maybe.ok | |
690 | - ). | |
691 | - | |
692 | -%-----------------------------------------------------------------------------% | |
693 | - | |
694 | -reduce(!Element, !Runtime, N, int.plus(N, 1), !Error) :- | |
695 | - reduce(!Element, !Runtime, !Error). | |
696 | - | |
697 | -%-----------------------------------------------------------------------------% | |
698 | - | |
699 | -execute(Element, Result, !Runtime) :- | |
700 | - preprocess(reduce, Element, PreprocessResult, !Runtime), | |
701 | - ( | |
702 | - PreprocessResult = maybe.error(Error), | |
703 | - Result = maybe.error(Error) | |
704 | - ; | |
705 | - PreprocessResult = maybe.ok(PreprocessOutput), | |
706 | - ( | |
707 | - PreprocessOutput = reduced(list(ReducedList)), | |
708 | - % Remove escaping during execution. | |
709 | - ( if | |
710 | - ReducedList = [atom(".")|Tail] | |
711 | - then | |
712 | - Result = maybe.ok(list(Tail)) | |
713 | - else | |
714 | - Result = maybe.ok(list(ReducedList)) | |
715 | - ) | |
716 | - ; | |
717 | - PreprocessOutput = reduced(atom(ReducedAtom)), | |
718 | - ( if | |
719 | - find_var(!.Runtime ^ stack_frames, | |
720 | - !.Runtime ^ globals, | |
721 | - ReducedAtom, SemiValue) | |
722 | - then | |
723 | - Result = maybe.ok(SemiValue) | |
724 | - else | |
725 | - Result = maybe.ok(atom(ReducedAtom)) | |
726 | - ) | |
727 | - ; | |
728 | - PreprocessOutput = comparison(Cmp, A, B, Tail), | |
729 | - | |
730 | - ( | |
731 | - % Incorrect tail length for comparison builtin. Good luck kid. | |
732 | - ( Tail = [] ; Tail = [_|[]] ; Tail = [_|[_|[_|_]]] ), | |
733 | - tl_runtime.builtin.comparison_tag(Cmp, Tag), | |
734 | - Result = maybe.error(func_error(Tag, 2, "Comparison must have arity of 2")) | |
735 | - ; | |
736 | - Tail = [Y|[N|[]]], | |
737 | - tl_runtime.builtin.comparison(Cmp, A, B, CmpResult), | |
738 | - ( | |
739 | - CmpResult = tl_runtime.builtin.error(Error), | |
740 | - tl_runtime.builtin.comparison_tag(Cmp, Tag), | |
741 | - Result = maybe.error(func_error(Tag, 2, Error)) | |
742 | - ; | |
743 | - ( | |
744 | - CmpResult = tl_runtime.builtin.yes, Choice = Y | |
745 | - ; | |
746 | - CmpResult = tl_runtime.builtin.no, Choice = N | |
747 | - ), | |
748 | - | |
749 | - % It should be safe to reduce the result. EIther it is known at | |
750 | - % compile-time, or the comparison will have failed to yield a | |
751 | - % result and we won't be in this arm. | |
752 | - reduce(Choice, ChoiceResult, !Runtime), | |
753 | - ( | |
754 | - ChoiceResult = maybe.error(Error), | |
755 | - tl_runtime.builtin.comparison_tag(Cmp, Tag), | |
756 | - Result = maybe.error(func_error(Tag, 2, Error)) | |
757 | - ; | |
758 | - ChoiceResult = maybe.ok(_), | |
759 | - Result = ChoiceResult | |
760 | - ) | |
761 | - ) | |
762 | - ) | |
763 | - ; | |
764 | - PreprocessOutput = execute(Tag, Tail, Arity), | |
765 | - | |
766 | - ( if | |
767 | - find_bind(Tag, Arity, !.Runtime ^ binds, Bind) | |
768 | - then | |
769 | - call_bind(Bind, Tail, CallResult, !Runtime), | |
770 | - ( | |
771 | - CallResult = maybe.error(Error), | |
772 | - Result = maybe.error(func_error(Tag, Arity, Error)) | |
773 | - ; | |
774 | - CallResult = maybe.ok(_), | |
775 | - Result = CallResult | |
776 | - ) | |
777 | - else | |
778 | - Result = maybe.ok(list([atom(Tag)|Tail])) | |
779 | - ) | |
780 | - ) | |
781 | - ). | |
782 | - | |
783 | -%-----------------------------------------------------------------------------% | |
784 | - | |
785 | -execute(!E, !R, maybe.error(E), maybe.error(E)). | |
786 | -execute(In, Out, !Runtime, maybe.ok, Result) :- | |
787 | - execute(In, OutResult, !Runtime), | |
788 | - ( | |
789 | - OutResult = maybe.error(Error), | |
790 | - Result = maybe.error(Error), | |
791 | - In = Out | |
792 | - ; | |
793 | - OutResult = maybe.ok(Out), | |
794 | - Result = maybe.ok | |
795 | - ). | |
796 | - | |
797 | -%-----------------------------------------------------------------------------% | |
798 | - | |
799 | -execute(!Element, !Runtime, N, int.plus(N, 1), !Error) :- | |
800 | - execute(!Element, !Runtime, !Error). | |
\ No newline at end of file |