Commit | Line | Data |
---|---|---|
2866f9a8 | 1 | CREATE OR REPLACE TYPE core_ns_T IS TABLE OF varchar2(100); |
9fc524f1 JM |
2 | / |
3 | ||
0fc03918 | 4 | CREATE OR REPLACE PACKAGE core IS |
2866f9a8 JM |
5 | FUNCTION do_core_func(M IN OUT NOCOPY types.mal_table, |
6 | H IN OUT NOCOPY types.map_entry_table, | |
7 | fn integer, | |
8 | a mal_vals) RETURN integer; | |
9fc524f1 | 9 | |
2866f9a8 | 10 | FUNCTION get_core_ns RETURN core_ns_T; |
0fc03918 | 11 | END core; |
9fc524f1 | 12 | / |
2866f9a8 | 13 | show errors; |
9fc524f1 JM |
14 | |
15 | ||
0fc03918 | 16 | CREATE OR REPLACE PACKAGE BODY core AS |
9fc524f1 JM |
17 | |
18 | -- general functions | |
2866f9a8 | 19 | FUNCTION equal_Q(M IN OUT NOCOPY types.mal_table, |
6a085103 | 20 | H IN OUT NOCOPY types.map_entry_table, |
2866f9a8 | 21 | args mal_vals) RETURN integer IS |
9fc524f1 | 22 | BEGIN |
6a085103 | 23 | RETURN types.tf(types.equal_Q(M, H, args(1), args(2))); |
9fc524f1 JM |
24 | END; |
25 | ||
150011e4 | 26 | -- scalar functiosn |
2866f9a8 | 27 | FUNCTION symbol(M IN OUT NOCOPY types.mal_table, |
150011e4 JM |
28 | val integer) RETURN integer IS |
29 | BEGIN | |
2866f9a8 | 30 | RETURN types.symbol(M, TREAT(M(val) AS mal_str_T).val_str); |
150011e4 JM |
31 | END; |
32 | ||
2866f9a8 | 33 | FUNCTION keyword(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
34 | val integer) RETURN integer IS |
35 | BEGIN | |
36 | IF types.string_Q(M, val) THEN | |
2866f9a8 | 37 | RETURN types.keyword(M, TREAT(M(val) AS mal_str_T).val_str); |
6a085103 JM |
38 | ELSIF types.keyword_Q(M, val) THEN |
39 | RETURN val; | |
40 | ELSE | |
41 | raise_application_error(-20009, | |
42 | 'invalid keyword call', TRUE); | |
43 | END IF; | |
44 | END; | |
45 | ||
150011e4 | 46 | |
9fc524f1 | 47 | -- string functions |
2866f9a8 | 48 | FUNCTION pr_str(M IN OUT NOCOPY types.mal_table, |
6a085103 | 49 | H IN OUT NOCOPY types.map_entry_table, |
2866f9a8 | 50 | args mal_vals) RETURN integer IS |
9fc524f1 | 51 | BEGIN |
6a085103 | 52 | RETURN types.string(M, printer.pr_str_seq(M, H, args, ' ', TRUE)); |
9fc524f1 JM |
53 | END; |
54 | ||
2866f9a8 | 55 | FUNCTION str(M IN OUT NOCOPY types.mal_table, |
6a085103 | 56 | H IN OUT NOCOPY types.map_entry_table, |
2866f9a8 | 57 | args mal_vals) RETURN integer IS |
9fc524f1 | 58 | BEGIN |
6a085103 | 59 | RETURN types.string(M, printer.pr_str_seq(M, H, args, '', FALSE)); |
9fc524f1 JM |
60 | END; |
61 | ||
2866f9a8 | 62 | FUNCTION prn(M IN OUT NOCOPY types.mal_table, |
6a085103 | 63 | H IN OUT NOCOPY types.map_entry_table, |
2866f9a8 | 64 | args mal_vals) RETURN integer IS |
9fc524f1 | 65 | BEGIN |
2866f9a8 | 66 | io.writeline(printer.pr_str_seq(M, H, args, ' ', TRUE)); |
0fc03918 | 67 | RETURN 1; -- nil |
9fc524f1 JM |
68 | END; |
69 | ||
2866f9a8 | 70 | FUNCTION println(M IN OUT NOCOPY types.mal_table, |
6a085103 | 71 | H IN OUT NOCOPY types.map_entry_table, |
2866f9a8 | 72 | args mal_vals) RETURN integer IS |
9fc524f1 | 73 | BEGIN |
2866f9a8 | 74 | io.writeline(printer.pr_str_seq(M, H, args, ' ', FALSE)); |
0fc03918 | 75 | RETURN 1; -- nil |
9fc524f1 JM |
76 | END; |
77 | ||
2866f9a8 | 78 | FUNCTION read_string(M IN OUT NOCOPY types.mal_table, |
6a085103 | 79 | H IN OUT NOCOPY types.map_entry_table, |
2866f9a8 | 80 | args mal_vals) RETURN integer IS |
06951f55 | 81 | BEGIN |
02936b42 JM |
82 | IF M(args(1)).type_id = 5 THEN |
83 | RETURN reader.read_str(M, H, | |
2866f9a8 | 84 | TREAT(M(args(1)) AS mal_str_T).val_str); |
02936b42 JM |
85 | ELSE |
86 | RETURN reader.read_str(M, H, | |
2866f9a8 | 87 | TREAT(M(args(1)) AS mal_long_str_T).val_long_str); |
02936b42 | 88 | END IF; |
06951f55 JM |
89 | END; |
90 | ||
2866f9a8 | 91 | FUNCTION readline(M IN OUT NOCOPY types.mal_table, |
10cc781f | 92 | prompt integer) RETURN integer IS |
02936b42 | 93 | input CLOB; |
10cc781f | 94 | BEGIN |
2866f9a8 | 95 | input := io.readline(TREAT(M(prompt) AS mal_str_T).val_str, 0); |
10cc781f JM |
96 | RETURN types.string(M, input); |
97 | EXCEPTION WHEN OTHERS THEN | |
98 | IF SQLCODE = -20001 THEN -- io streams closed | |
99 | RETURN 1; -- nil | |
100 | ELSE | |
101 | RAISE; | |
102 | END IF; | |
103 | END; | |
104 | ||
2866f9a8 JM |
105 | FUNCTION slurp(M IN OUT NOCOPY types.mal_table, |
106 | args mal_vals) RETURN integer IS | |
02936b42 | 107 | content CLOB; |
06951f55 | 108 | BEGIN |
2866f9a8 | 109 | content := io.file_open_and_read(TREAT(M(args(1)) AS mal_str_T).val_str); |
06951f55 | 110 | content := REPLACE(content, '\n', chr(10)); |
0fc03918 | 111 | RETURN types.string(M, content); |
06951f55 JM |
112 | END; |
113 | ||
9fc524f1 JM |
114 | |
115 | -- numeric functions | |
2866f9a8 JM |
116 | FUNCTION lt(M IN OUT NOCOPY types.mal_table, |
117 | args mal_vals) RETURN integer IS | |
9fc524f1 | 118 | BEGIN |
2866f9a8 JM |
119 | RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int < |
120 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
121 | END; |
122 | ||
2866f9a8 JM |
123 | FUNCTION lte(M IN OUT NOCOPY types.mal_table, |
124 | args mal_vals) RETURN integer IS | |
9fc524f1 | 125 | BEGIN |
2866f9a8 JM |
126 | RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int <= |
127 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
128 | END; |
129 | ||
2866f9a8 JM |
130 | FUNCTION gt(M IN OUT NOCOPY types.mal_table, |
131 | args mal_vals) RETURN integer IS | |
9fc524f1 | 132 | BEGIN |
2866f9a8 JM |
133 | RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int > |
134 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
135 | END; |
136 | ||
2866f9a8 JM |
137 | FUNCTION gte(M IN OUT NOCOPY types.mal_table, |
138 | args mal_vals) RETURN integer IS | |
9fc524f1 | 139 | BEGIN |
2866f9a8 JM |
140 | RETURN types.tf(TREAT(M(args(1)) AS mal_int_T).val_int >= |
141 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
142 | END; |
143 | ||
2866f9a8 JM |
144 | FUNCTION add(M IN OUT NOCOPY types.mal_table, |
145 | args mal_vals) RETURN integer IS | |
9fc524f1 | 146 | BEGIN |
2866f9a8 JM |
147 | RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int + |
148 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
149 | END; |
150 | ||
2866f9a8 JM |
151 | FUNCTION subtract(M IN OUT NOCOPY types.mal_table, |
152 | args mal_vals) RETURN integer IS | |
9fc524f1 | 153 | BEGIN |
2866f9a8 JM |
154 | RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int - |
155 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
156 | END; |
157 | ||
2866f9a8 JM |
158 | FUNCTION multiply(M IN OUT NOCOPY types.mal_table, |
159 | args mal_vals) RETURN integer IS | |
9fc524f1 | 160 | BEGIN |
2866f9a8 JM |
161 | RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int * |
162 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
163 | END; |
164 | ||
2866f9a8 JM |
165 | FUNCTION divide(M IN OUT NOCOPY types.mal_table, |
166 | args mal_vals) RETURN integer IS | |
9fc524f1 | 167 | BEGIN |
2866f9a8 JM |
168 | RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int / |
169 | TREAT(M(args(2)) AS mal_int_T).val_int); | |
9fc524f1 JM |
170 | END; |
171 | ||
2866f9a8 | 172 | FUNCTION time_ms(M IN OUT NOCOPY types.mal_table) RETURN integer IS |
10cc781f JM |
173 | now integer; |
174 | BEGIN | |
2866f9a8 JM |
175 | SELECT extract(day from(sys_extract_utc(systimestamp) - |
176 | to_timestamp('1970-01-01', 'YYYY-MM-DD'))) * 86400000 + | |
177 | to_number(to_char(sys_extract_utc(systimestamp), 'SSSSSFF3')) | |
10cc781f JM |
178 | INTO now |
179 | FROM dual; | |
180 | RETURN types.int(M, now); | |
181 | END; | |
182 | ||
6a085103 | 183 | -- hash-map functions |
2866f9a8 | 184 | FUNCTION assoc(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
185 | H IN OUT NOCOPY types.map_entry_table, |
186 | hm integer, | |
2866f9a8 | 187 | kvs mal_vals) RETURN integer IS |
6a085103 JM |
188 | new_hm integer; |
189 | midx integer; | |
190 | BEGIN | |
191 | new_hm := types.clone(M, H, hm); | |
2866f9a8 | 192 | midx := TREAT(M(new_hm) AS mal_map_T).map_idx; |
6a085103 JM |
193 | -- Add the new key/values |
194 | midx := types.assoc_BANG(M, H, midx, kvs); | |
195 | RETURN new_hm; | |
196 | END; | |
197 | ||
2866f9a8 | 198 | FUNCTION dissoc(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
199 | H IN OUT NOCOPY types.map_entry_table, |
200 | hm integer, | |
2866f9a8 | 201 | ks mal_vals) RETURN integer IS |
6a085103 JM |
202 | new_hm integer; |
203 | midx integer; | |
204 | BEGIN | |
205 | new_hm := types.clone(M, H, hm); | |
2866f9a8 | 206 | midx := TREAT(M(new_hm) AS mal_map_T).map_idx; |
6a085103 JM |
207 | -- Remove the keys |
208 | midx := types.dissoc_BANG(M, H, midx, ks); | |
209 | RETURN new_hm; | |
210 | END; | |
211 | ||
212 | ||
2866f9a8 | 213 | FUNCTION get(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
214 | H IN OUT NOCOPY types.map_entry_table, |
215 | hm integer, key integer) RETURN integer IS | |
216 | midx integer; | |
217 | k varchar2(256); | |
218 | val integer; | |
219 | BEGIN | |
220 | IF M(hm).type_id = 0 THEN | |
221 | RETURN 1; -- nil | |
222 | END IF; | |
2866f9a8 JM |
223 | midx := TREAT(M(hm) AS mal_map_T).map_idx; |
224 | k := TREAT(M(key) AS mal_str_T).val_str; | |
6a085103 JM |
225 | IF H(midx).EXISTS(k) THEN |
226 | RETURN H(midx)(k); | |
227 | ELSE | |
228 | RETURN 1; -- nil | |
229 | END IF; | |
230 | END; | |
231 | ||
2866f9a8 | 232 | FUNCTION contains_Q(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
233 | H IN OUT NOCOPY types.map_entry_table, |
234 | hm integer, key integer) RETURN integer IS | |
235 | midx integer; | |
236 | k varchar2(256); | |
237 | val integer; | |
238 | BEGIN | |
2866f9a8 JM |
239 | midx := TREAT(M(hm) AS mal_map_T).map_idx; |
240 | k := TREAT(M(key) AS mal_str_T).val_str; | |
6a085103 JM |
241 | RETURN types.tf(H(midx).EXISTS(k)); |
242 | END; | |
243 | ||
2866f9a8 | 244 | FUNCTION keys(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
245 | H IN OUT NOCOPY types.map_entry_table, |
246 | hm integer) RETURN integer IS | |
247 | midx integer; | |
248 | k varchar2(256); | |
2866f9a8 | 249 | ks mal_vals; |
6a085103 JM |
250 | val integer; |
251 | BEGIN | |
2866f9a8 JM |
252 | midx := TREAT(M(hm) AS mal_map_T).map_idx; |
253 | ks := mal_vals(); | |
6a085103 JM |
254 | |
255 | k := H(midx).FIRST(); | |
256 | WHILE k IS NOT NULL LOOP | |
257 | ks.EXTEND(); | |
258 | ks(ks.COUNT()) := types.string(M, k); | |
259 | k := H(midx).NEXT(k); | |
260 | END LOOP; | |
261 | ||
262 | RETURN types.seq(M, 8, ks); | |
263 | END; | |
264 | ||
2866f9a8 | 265 | FUNCTION vals(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
266 | H IN OUT NOCOPY types.map_entry_table, |
267 | hm integer) RETURN integer IS | |
268 | midx integer; | |
269 | k varchar2(256); | |
2866f9a8 | 270 | ks mal_vals; |
6a085103 JM |
271 | val integer; |
272 | BEGIN | |
2866f9a8 JM |
273 | midx := TREAT(M(hm) AS mal_map_T).map_idx; |
274 | ks := mal_vals(); | |
6a085103 JM |
275 | |
276 | k := H(midx).FIRST(); | |
277 | WHILE k IS NOT NULL LOOP | |
278 | ks.EXTEND(); | |
279 | ks(ks.COUNT()) := H(midx)(k); | |
280 | k := H(midx).NEXT(k); | |
281 | END LOOP; | |
282 | ||
283 | RETURN types.seq(M, 8, ks); | |
284 | END; | |
285 | ||
286 | ||
0fc03918 | 287 | -- sequence functions |
2866f9a8 JM |
288 | FUNCTION cons(M IN OUT NOCOPY types.mal_table, |
289 | args mal_vals) RETURN integer IS | |
290 | new_items mal_vals; | |
0fc03918 JM |
291 | len integer; |
292 | i integer; | |
293 | BEGIN | |
2866f9a8 | 294 | new_items := mal_vals(); |
0fc03918 JM |
295 | len := types.count(M, args(2)); |
296 | new_items.EXTEND(len+1); | |
297 | new_items(1) := args(1); | |
298 | FOR i IN 1..len LOOP | |
2866f9a8 | 299 | new_items(i+1) := TREAT(M(args(2)) AS mal_seq_T).val_seq(i); |
0fc03918 JM |
300 | END LOOP; |
301 | RETURN types.seq(M, 8, new_items); | |
302 | END; | |
303 | ||
2866f9a8 JM |
304 | FUNCTION concat(M IN OUT NOCOPY types.mal_table, |
305 | args mal_vals) RETURN integer IS | |
306 | new_items mal_vals; | |
0fc03918 JM |
307 | cur_len integer; |
308 | seq_len integer; | |
309 | i integer; | |
310 | j integer; | |
311 | BEGIN | |
2866f9a8 | 312 | new_items := mal_vals(); |
0fc03918 JM |
313 | cur_len := 0; |
314 | FOR i IN 1..args.COUNT() LOOP | |
315 | seq_len := types.count(M, args(i)); | |
316 | new_items.EXTEND(seq_len); | |
317 | FOR j IN 1..seq_len LOOP | |
318 | new_items(cur_len + j) := types.nth(M, args(i), j-1); | |
319 | END LOOP; | |
320 | cur_len := cur_len + seq_len; | |
321 | END LOOP; | |
322 | RETURN types.seq(M, 8, new_items); | |
323 | END; | |
324 | ||
325 | ||
2866f9a8 | 326 | FUNCTION nth(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
327 | val integer, |
328 | ival integer) RETURN integer IS | |
329 | idx integer; | |
330 | BEGIN | |
2866f9a8 | 331 | idx := TREAT(M(ival) AS mal_int_T).val_int; |
6a085103 JM |
332 | RETURN types.nth(M, val, idx); |
333 | END; | |
334 | ||
2866f9a8 | 335 | FUNCTION first(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
336 | val integer) RETURN integer IS |
337 | BEGIN | |
338 | IF val = 1 OR types.count(M, val) = 0 THEN | |
339 | RETURN 1; -- nil | |
340 | ELSE | |
341 | RETURN types.first(M, val); | |
342 | END IF; | |
343 | END; | |
344 | ||
2866f9a8 | 345 | FUNCTION rest(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
346 | val integer) RETURN integer IS |
347 | BEGIN | |
348 | IF val = 1 OR types.count(M, val) = 0 THEN | |
349 | RETURN types.list(M); | |
350 | ELSE | |
351 | RETURN types.slice(M, val, 1); | |
352 | END IF; | |
353 | END; | |
354 | ||
2866f9a8 | 355 | FUNCTION do_count(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
356 | val integer) RETURN integer IS |
357 | BEGIN | |
358 | IF M(val).type_id = 0 THEN | |
359 | RETURN types.int(M, 0); | |
360 | ELSE | |
361 | RETURN types.int(M, types.count(M, val)); | |
362 | END IF; | |
363 | END; | |
364 | ||
365 | ||
2866f9a8 | 366 | FUNCTION conj(M IN OUT NOCOPY types.mal_table, |
6a085103 | 367 | seq integer, |
2866f9a8 | 368 | vals mal_vals) RETURN integer IS |
6a085103 JM |
369 | type_id integer; |
370 | slen integer; | |
2866f9a8 | 371 | items mal_vals; |
6a085103 JM |
372 | BEGIN |
373 | type_id := M(seq).type_id; | |
374 | slen := types.count(M, seq); | |
2866f9a8 | 375 | items := mal_vals(); |
6a085103 JM |
376 | items.EXTEND(slen + vals.COUNT()); |
377 | CASE | |
378 | WHEN type_id = 8 THEN | |
379 | FOR i IN 1..vals.COUNT() LOOP | |
380 | items(i) := vals(vals.COUNT + 1 - i); | |
381 | END LOOP; | |
382 | FOR i IN 1..slen LOOP | |
383 | items(vals.COUNT() + i) := types.nth(M, seq, i-1); | |
384 | END LOOP; | |
385 | WHEN type_id = 9 THEN | |
386 | FOR i IN 1..slen LOOP | |
387 | items(i) := types.nth(M, seq, i-1); | |
388 | END LOOP; | |
389 | FOR i IN 1..vals.COUNT() LOOP | |
390 | items(slen + i) := vals(i); | |
391 | END LOOP; | |
392 | ELSE | |
393 | raise_application_error(-20009, | |
394 | 'conj: not supported on type ' || type_id, TRUE); | |
395 | END CASE; | |
396 | RETURN types.seq(M, type_id, items); | |
397 | END; | |
398 | ||
2866f9a8 | 399 | FUNCTION seq(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
400 | val integer) RETURN integer IS |
401 | type_id integer; | |
402 | new_val integer; | |
02936b42 | 403 | str CLOB; |
2866f9a8 | 404 | str_items mal_vals; |
6a085103 JM |
405 | BEGIN |
406 | type_id := M(val).type_id; | |
407 | CASE | |
408 | WHEN type_id = 8 THEN | |
409 | IF types.count(M, val) = 0 THEN | |
410 | RETURN 1; -- nil | |
411 | END IF; | |
412 | RETURN val; | |
413 | WHEN type_id = 9 THEN | |
414 | IF types.count(M, val) = 0 THEN | |
415 | RETURN 1; -- nil | |
416 | END IF; | |
2866f9a8 | 417 | RETURN types.seq(M, 8, TREAT(M(val) AS mal_seq_T).val_seq); |
6a085103 | 418 | WHEN types.string_Q(M, val) THEN |
2866f9a8 | 419 | str := TREAT(M(val) AS mal_str_T).val_str; |
6a085103 JM |
420 | IF str IS NULL THEN |
421 | RETURN 1; -- nil | |
422 | END IF; | |
2866f9a8 | 423 | str_items := mal_vals(); |
6a085103 JM |
424 | str_items.EXTEND(LENGTH(str)); |
425 | FOR i IN 1..LENGTH(str) LOOP | |
426 | str_items(i) := types.string(M, SUBSTR(str, i, 1)); | |
427 | END LOOP; | |
428 | RETURN types.seq(M, 8, str_items); | |
429 | WHEN type_id = 0 THEN | |
430 | RETURN 1; -- nil | |
431 | ELSE | |
432 | raise_application_error(-20009, | |
433 | 'seq: not supported on type ' || type_id, TRUE); | |
434 | END CASE; | |
435 | END; | |
436 | ||
6a085103 | 437 | -- metadata functions |
2866f9a8 | 438 | FUNCTION meta(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
439 | val integer) RETURN integer IS |
440 | type_id integer; | |
441 | BEGIN | |
442 | type_id := M(val).type_id; | |
443 | IF type_id IN (8,9) THEN -- list/vector | |
2866f9a8 | 444 | RETURN TREAT(M(val) AS mal_seq_T).meta; |
6a085103 | 445 | ELSIF type_id = 10 THEN -- hash-map |
2866f9a8 | 446 | RETURN TREAT(M(val) AS mal_map_T).meta; |
6a085103 JM |
447 | ELSIF type_id = 11 THEN -- native function |
448 | RETURN 1; -- nil | |
449 | ELSIF type_id = 12 THEN -- mal function | |
2866f9a8 | 450 | RETURN TREAT(M(val) AS mal_func_T).meta; |
6a085103 JM |
451 | ELSE |
452 | raise_application_error(-20006, | |
453 | 'meta: metadata not supported on type', TRUE); | |
454 | END IF; | |
455 | END; | |
456 | ||
9fc524f1 | 457 | -- general native function case/switch |
2866f9a8 | 458 | FUNCTION do_core_func(M IN OUT NOCOPY types.mal_table, |
6a085103 JM |
459 | H IN OUT NOCOPY types.map_entry_table, |
460 | fn integer, | |
2866f9a8 | 461 | a mal_vals) RETURN integer IS |
02936b42 | 462 | fname varchar(256); |
0fc03918 | 463 | idx integer; |
9fc524f1 | 464 | BEGIN |
0fc03918 | 465 | IF M(fn).type_id <> 11 THEN |
9fc524f1 JM |
466 | raise_application_error(-20004, |
467 | 'Invalid function call', TRUE); | |
468 | END IF; | |
469 | ||
2866f9a8 | 470 | fname := TREAT(M(fn) AS mal_str_T).val_str; |
9fc524f1 JM |
471 | |
472 | CASE | |
6a085103 JM |
473 | WHEN fname = '=' THEN RETURN equal_Q(M, H, a); |
474 | ||
475 | WHEN fname = 'nil?' THEN RETURN types.tf(a(1) = 1); | |
476 | WHEN fname = 'false?' THEN RETURN types.tf(a(1) = 2); | |
477 | WHEN fname = 'true?' THEN RETURN types.tf(a(1) = 3); | |
478 | WHEN fname = 'string?' THEN RETURN types.tf(types.string_Q(M, a(1))); | |
479 | WHEN fname = 'symbol' THEN RETURN symbol(M, a(1)); | |
480 | WHEN fname = 'symbol?' THEN RETURN types.tf(M(a(1)).type_id = 7); | |
481 | WHEN fname = 'keyword' THEN RETURN keyword(M, a(1)); | |
482 | WHEN fname = 'keyword?' THEN RETURN types.tf(types.keyword_Q(M, a(1))); | |
aa42fdce JM |
483 | WHEN fname = 'number?' THEN RETURN types.tf(types.number_Q(M, a(1))); |
484 | WHEN fname = 'fn?' THEN RETURN types.tf(types.function_Q(M, a(1))); | |
485 | WHEN fname = 'macro?' THEN RETURN types.tf(types.macro_Q(M, a(1))); | |
6a085103 JM |
486 | |
487 | WHEN fname = 'pr-str' THEN RETURN pr_str(M, H, a); | |
488 | WHEN fname = 'str' THEN RETURN str(M, H, a); | |
489 | WHEN fname = 'prn' THEN RETURN prn(M, H, a); | |
490 | WHEN fname = 'println' THEN RETURN println(M, H, a); | |
491 | WHEN fname = 'read-string' THEN RETURN read_string(M, H, a); | |
492 | WHEN fname = 'readline' THEN RETURN readline(M, a(1)); | |
493 | WHEN fname = 'slurp' THEN RETURN slurp(M, a); | |
494 | ||
495 | WHEN fname = '<' THEN RETURN lt(M, a); | |
496 | WHEN fname = '<=' THEN RETURN lte(M, a); | |
497 | WHEN fname = '>' THEN RETURN gt(M, a); | |
498 | WHEN fname = '>=' THEN RETURN gte(M, a); | |
499 | WHEN fname = '+' THEN RETURN add(M, a); | |
500 | WHEN fname = '-' THEN RETURN subtract(M, a); | |
501 | WHEN fname = '*' THEN RETURN multiply(M, a); | |
502 | WHEN fname = '/' THEN RETURN divide(M, a); | |
503 | WHEN fname = 'time-ms' THEN RETURN time_ms(M); | |
504 | ||
505 | WHEN fname = 'list' THEN RETURN types.seq(M, 8, a); | |
506 | WHEN fname = 'list?' THEN RETURN types.tf(M(a(1)).type_id = 8); | |
507 | WHEN fname = 'vector' THEN RETURN types.seq(M, 9, a); | |
508 | WHEN fname = 'vector?' THEN RETURN types.tf(M(a(1)).type_id = 9); | |
509 | WHEN fname = 'hash-map' THEN RETURN types.hash_map(M, H, a); | |
510 | WHEN fname = 'assoc' THEN RETURN assoc(M, H, a(1), types.islice(a, 1)); | |
511 | WHEN fname = 'dissoc' THEN RETURN dissoc(M, H, a(1), types.islice(a, 1)); | |
512 | WHEN fname = 'map?' THEN RETURN types.tf(M(a(1)).type_id = 10); | |
513 | WHEN fname = 'get' THEN RETURN get(M, H, a(1), a(2)); | |
514 | WHEN fname = 'contains?' THEN RETURN contains_Q(M, H, a(1), a(2)); | |
515 | WHEN fname = 'keys' THEN RETURN keys(M, H, a(1)); | |
516 | WHEN fname = 'vals' THEN RETURN vals(M, H, a(1)); | |
517 | ||
518 | WHEN fname = 'sequential?' THEN RETURN types.tf(M(a(1)).type_id IN (8,9)); | |
519 | WHEN fname = 'cons' THEN RETURN cons(M, a); | |
520 | WHEN fname = 'concat' THEN RETURN concat(M, a); | |
521 | WHEN fname = 'nth' THEN RETURN nth(M, a(1), a(2)); | |
522 | WHEN fname = 'first' THEN RETURN first(M, a(1)); | |
523 | WHEN fname = 'rest' THEN RETURN rest(M, a(1)); | |
524 | WHEN fname = 'empty?' THEN RETURN types.tf(0 = types.count(M, a(1))); | |
525 | WHEN fname = 'count' THEN RETURN do_count(M, a(1)); | |
526 | ||
527 | WHEN fname = 'conj' THEN RETURN conj(M, a(1), types.islice(a, 1)); | |
528 | WHEN fname = 'seq' THEN RETURN seq(M, a(1)); | |
529 | ||
530 | WHEN fname = 'meta' THEN RETURN meta(M, a(1)); | |
531 | WHEN fname = 'with-meta' THEN RETURN types.clone(M, H, a(1), a(2)); | |
532 | WHEN fname = 'atom' THEN RETURN types.atom_new(M, a(1)); | |
533 | WHEN fname = 'atom?' THEN RETURN types.tf(M(a(1)).type_id = 13); | |
2866f9a8 JM |
534 | WHEN fname = 'deref' THEN RETURN TREAT(M(a(1)) AS mal_atom_T).val; |
535 | WHEN fname = 'reset!' THEN RETURN types.atom_reset(M, a(1), a(2)); | |
6a085103 JM |
536 | |
537 | ELSE raise_application_error(-20004, 'Invalid function call', TRUE); | |
9fc524f1 JM |
538 | END CASE; |
539 | END; | |
540 | ||
2866f9a8 | 541 | FUNCTION get_core_ns RETURN core_ns_T IS |
9fc524f1 | 542 | BEGIN |
2866f9a8 | 543 | RETURN core_ns_T( |
9fc524f1 | 544 | '=', |
150011e4 JM |
545 | 'throw', |
546 | ||
547 | 'nil?', | |
548 | 'true?', | |
549 | 'false?', | |
6a085103 | 550 | 'string?', |
150011e4 JM |
551 | 'symbol', |
552 | 'symbol?', | |
6a085103 JM |
553 | 'keyword', |
554 | 'keyword?', | |
aa42fdce JM |
555 | 'number?', |
556 | 'fn?', | |
557 | 'macro?', | |
9fc524f1 JM |
558 | |
559 | 'pr-str', | |
560 | 'str', | |
561 | 'prn', | |
562 | 'println', | |
06951f55 | 563 | 'read-string', |
10cc781f | 564 | 'readline', |
06951f55 | 565 | 'slurp', |
9fc524f1 JM |
566 | |
567 | '<', | |
568 | '<=', | |
569 | '>', | |
570 | '>=', | |
571 | '+', | |
572 | '-', | |
573 | '*', | |
574 | '/', | |
10cc781f | 575 | 'time-ms', |
9fc524f1 JM |
576 | |
577 | 'list', | |
578 | 'list?', | |
6a085103 JM |
579 | 'vector', |
580 | 'vector?', | |
581 | 'hash-map', | |
582 | 'assoc', | |
583 | 'dissoc', | |
584 | 'map?', | |
585 | 'get', | |
586 | 'contains?', | |
587 | 'keys', | |
588 | 'vals', | |
589 | ||
590 | 'sequential?', | |
0fc03918 JM |
591 | 'cons', |
592 | 'concat', | |
593 | 'nth', | |
594 | 'first', | |
595 | 'rest', | |
9fc524f1 | 596 | 'empty?', |
06951f55 | 597 | 'count', |
6a085103 JM |
598 | 'apply', -- defined in step do_builtin function |
599 | 'map', -- defined in step do_builtin function | |
600 | ||
601 | 'conj', | |
602 | 'seq', | |
06951f55 | 603 | |
6a085103 JM |
604 | 'meta', |
605 | 'with-meta', | |
06951f55 JM |
606 | 'atom', |
607 | 'atom?', | |
608 | 'deref', | |
609 | 'reset!', | |
6a085103 JM |
610 | 'swap!' -- defined in step do_builtin function |
611 | ); | |
9fc524f1 JM |
612 | END; |
613 | ||
0fc03918 | 614 | END core; |
9fc524f1 JM |
615 | / |
616 | show errors; |