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