4 function core_eq_sub
(lhs
, rhs
, i
, len
)
6 if (lhs ~
/^
[([]/ && rhs ~
/^
[([]/) {
9 len = types_heap
[lhs
]["len"]
10 if (len
!= types_heap
[rhs
]["len"]) {
13 for (i =
0; i
< len
; ++i
) {
14 if (!core_eq_sub
(types_heap
[lhs
][i
], types_heap
[rhs
][i
])) {
19 } else if (lhs ~
/^\
{/ && rhs ~
/^\
{/) {
22 if (length(types_heap
[lhs
]) != length(types_heap
[rhs
])) {
25 for (i in types_heap
[lhs
]) {
26 if (types_heap
[lhs
][i
] ~
/^
["':+#([{?&$%]/ &&
27 !core_eq_sub(types_heap[lhs][i], types_heap[rhs][i])) {
39 if (types_heap[idx]["len
"] != 3) {
40 return "!
\"Invalid argument
length for builtin
function '='. Expects exactly
2 arguments
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
42 return core_eq_sub(types_heap[idx][1], types_heap[idx][2]) ? "#true" : "#false"
45 function core_throw
(idx
)
47 if (types_heap
[idx
]["len"] != 2) {
48 return "!\"Invalid argument length for builtin function 'throw'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
50 return "!" types_addref
(types_heap
[idx
][1])
55 function core_nilp
(idx
)
57 if (types_heap
[idx
]["len"] != 2) {
58 return "!\"Invalid argument length for builtin function 'nil?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
60 return types_heap
[idx
][1] ==
"#nil" ?
"#true" : "#false"
63 function core_truep
(idx
)
65 if (types_heap
[idx
]["len"] != 2) {
66 return "!\"Invalid argument length for builtin function 'true?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
68 return types_heap
[idx
][1] ==
"#true" ?
"#true" : "#false"
71 function core_falsep
(idx
)
73 if (types_heap
[idx
]["len"] != 2) {
74 return "!\"Invalid argument length for builtin function 'false?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
76 return types_heap
[idx
][1] ==
"#false" ?
"#true" : "#false"
79 function core_stringp
(idx
)
81 if (types_heap
[idx
]["len"] != 2) {
82 return "!\"Invalid argument length for builtin function 'string?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
84 return types_heap
[idx
][1] ~
/^
"/ ? "#true" : "#false"
87 function core_symbol
(idx
, str
)
89 if (types_heap
[idx
]["len"] != 2) {
90 return "!\"Invalid argument length for builtin function 'symbol'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
92 str = types_heap
[idx
][1]
94 return "!
\"Incompatible type
for argument
1 of builtin
function 'symbol'. Expects string
, supplied
" types_typename(str) ".
"
96 return "'" substr(str, 2)
99 function core_symbolp(idx)
101 if (types_heap[idx]["len"] != 2) {
102 return "!\"Invalid argument length for builtin function 'symbol?
'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
104 return types_heap[idx][1] ~ /^'/ ?
"#true" : "#false"
107 function core_keyword
(idx
, str
)
109 if (types_heap
[idx
]["len"] != 2) {
110 return "!\"Invalid argument length for builtin function 'keyword'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
112 str = types_heap
[idx
][1]
117 return "::" substr(str, 2)
119 return "!
\"Incompatible type
for argument
1 of builtin
function 'keyword'. Expects string or keyword
, supplied
" types_typename(str) ".
"
122 function core_keywordp(idx)
124 if (types_heap[idx]["len
"] != 2) {
125 return "!
\"Invalid argument
length for builtin
function 'keyword?'. Expects exactly
1 argument
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
127 return types_heap[idx][1] ~ /^:/ ? "#true" : "#false"
130 function core_numberp
(idx
)
132 if (types_heap
[idx
]["len"] != 2) {
133 return "!\"Invalid argument length for builtin function 'number?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
135 return types_heap
[idx
][1] ~
/^\
+/ ?
"#true" : "#false"
138 function core_fnp
(idx
)
140 if (types_heap
[idx
]["len"] != 2) {
141 return "!\"Invalid argument length for builtin function 'fn?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
143 f = types_heap
[idx
][1]
144 return f ~
/^
[$
&%
]/ && !types_heap
[substr(f
, 2)]["is_macro"] ?
"#true" : "#false"
147 function core_macrop
(idx
)
149 if (types_heap
[idx
]["len"] != 2) {
150 return "!\"Invalid argument length for builtin function 'macro?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
152 f = types_heap
[idx
][1]
153 return f ~
/^\$
/ && types_heap
[substr(f
, 2)]["is_macro"] ?
"#true" : "#false"
158 function core_pr_str
(idx
, i
, len
, result
)
160 len = types_heap
[idx
]["len"]
161 for (i =
1; i
< len
; ++i
) {
162 result = result printer_pr_str
(types_heap
[idx
][i
], 1) " "
164 return "\"" substr(result
, 1, length(result
) - 1)
167 function core_str
(idx
, i
, len
, result
)
169 len = types_heap
[idx
]["len"]
170 for (i =
1; i
< len
; ++i
) {
171 result = result printer_pr_str
(types_heap
[idx
][i
], 0)
176 function core_prn
(idx
, i
, len
, result
)
178 len = types_heap
[idx
]["len"]
179 for (i =
1; i
< len
; ++i
) {
180 result = result printer_pr_str
(types_heap
[idx
][i
], 1) " "
182 print substr(result
, 1, length(result
) - 1)
186 function core_println
(idx
, i
, len
, result
)
188 len = types_heap
[idx
]["len"]
189 for (i =
1; i
< len
; ++i
) {
190 result = result printer_pr_str
(types_heap
[idx
][i
], 0) " "
192 print substr(result
, 1, length(result
) - 1)
196 function core_read_string
(idx
, str
)
198 if (types_heap
[idx
]["len"] != 2) {
199 return "!\"Invalid argument length for builtin function 'read-string'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
201 str = types_heap
[idx
][1]
203 return "!
\"Incompatible type
for argument
1 of builtin
function 'read-string'. Expects string
, supplied
" types_typename(str) ".
"
205 return reader_read_str(substr(str, 2))
208 function core_readline(idx, prompt, var)
210 if (types_heap[idx]["len
"] != 2) {
211 return "!
\"Invalid argument
length for builtin
function 'readline'. Expects exactly
1 argument
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
213 prompt = types_heap[idx][1]
214 if (prompt !~ /^"/) {
215 return "!\"Incompatible type for argument 1 of builtin function 'readline'. Expects string, supplied " types_typename
(prompt
) "."
217 printf("%s", printer_pr_str
(prompt
, 0))
218 return getline var
<=
0 ?
"#nil" : "\"" var
221 function core_slurp
(idx
, filename, str
)
223 if (types_heap
[idx
]["len"] != 2) {
224 return "!\"Invalid argument length for builtin function 'slurp'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
226 filename = types_heap
[idx
][1]
227 if (filename !~
/^
"/) {
228 return "!
\"Incompatible type
for argument
1 of builtin
function 'slurp'. Expects string
, supplied
" types_typename(filename) ".
"
230 str = readfile(substr(filename, 2))
231 if (str == "" && ERRNO != "") {
232 return "!
\"cannot read file
'" filename "', ERRNO =
" ERRNO
239 function core_lt(idx, lhs, rhs)
241 if (types_heap[idx]["len
"] != 3) {
242 return "!
\"Invalid argument
length for builtin
function '<'. Expects exactly
2 arguments
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
244 lhs = types_heap[idx][1]
246 return "!
\"Incompatible type
for argument
1 of builtin
function '<'. Expects number
, supplied
" types_typename(lhs) ".
"
248 rhs = types_heap[idx][2]
250 return "!
\"Incompatible type
for argument
2 of builtin
function '<'. Expects number
, supplied
" types_typename(rhs) ".
"
252 return substr(lhs, 2) + 0 < substr(rhs, 2) + 0 ? "#true" : "#false"
255 function core_le
(idx
, lhs
, rhs
)
257 if (types_heap
[idx
]["len"] != 3) {
258 return "!\"Invalid argument length for builtin function '<='. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
260 lhs = types_heap
[idx
][1]
262 return "!\"Incompatible type for argument 1 of builtin function '<='. Expects number, supplied " types_typename
(lhs
) "."
264 rhs = types_heap
[idx
][2]
266 return "!\"Incompatible type for argument 2 of builtin function '<='. Expects number, supplied " types_typename
(rhs
) "."
268 return substr(lhs
, 2) + 0 <=
substr(rhs
, 2) + 0 ?
"#true" : "#false"
271 function core_gt
(idx
, lhs
, rhs
)
273 if (types_heap
[idx
]["len"] != 3) {
274 return "!\"Invalid argument length for builtin function '>'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
276 lhs = types_heap
[idx
][1]
278 return "!\"Incompatible type for argument 1 of builtin function '>'. Expects number, supplied " types_typename
(lhs
) "."
280 rhs = types_heap
[idx
][2]
282 return "!\"Incompatible type for argument 2 of builtin function '>'. Expects number, supplied " types_typename
(rhs
) "."
284 return substr(lhs
, 2) + 0 > substr(rhs
, 2) + 0 ?
"#true" : "#false"
287 function core_ge
(idx
, lhs
, rhs
)
289 if (types_heap
[idx
]["len"] != 3) {
290 return "!\"Invalid argument length for builtin function '>='. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
292 lhs = types_heap
[idx
][1]
294 return "!\"Incompatible type for argument 1 of builtin function '>='. Expects number, supplied " types_typename
(lhs
) "."
296 rhs = types_heap
[idx
][2]
298 return "!\"Incompatible type for argument 2 of builtin function '>='. Expects number, supplied " types_typename
(rhs
) "."
300 return substr(lhs
, 2) + 0 >=
substr(rhs
, 2) + 0 ?
"#true" : "#false"
303 function core_add
(idx
, lhs
, rhs
)
305 if (types_heap
[idx
]["len"] != 3) {
306 return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
308 lhs = types_heap
[idx
][1]
310 return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename
(lhs
) "."
312 rhs = types_heap
[idx
][2]
314 return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename
(rhs
) "."
316 return "+" (substr(lhs
, 2) + substr(rhs
, 2))
319 function core_subtract
(idx
, lhs
, rhs
)
321 if (types_heap
[idx
]["len"] != 3) {
322 return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
324 lhs = types_heap
[idx
][1]
326 return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename
(lhs
) "."
328 rhs = types_heap
[idx
][2]
330 return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename
(rhs
) "."
332 return "+" (substr(lhs
, 2) - substr(rhs
, 2))
335 function core_multiply
(idx
, lhs
, rhs
)
337 if (types_heap
[idx
]["len"] != 3) {
338 return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
340 lhs = types_heap
[idx
][1]
342 return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename
(lhs
) "."
344 rhs = types_heap
[idx
][2]
346 return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename
(rhs
) "."
348 return "+" (substr(lhs
, 2) * substr(rhs
, 2))
351 function core_divide
(idx
, lhs
, rhs
)
353 if (types_heap
[idx
]["len"] != 3) {
354 return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
356 lhs = types_heap
[idx
][1]
358 return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename
(lhs
) "."
360 rhs = types_heap
[idx
][2]
362 return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename
(rhs
) "."
364 return "+" int
(substr(lhs
, 2) / substr(rhs
, 2))
367 function core_time_ms
(idx
)
369 if (types_heap
[idx
]["len"] != 1) {
370 return "!\"Invalid argument length for builtin function 'time-ms'. Expects no arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
372 return "+" int
(gettimeofday
() * 1000)
377 function core_list
(idx
, new_idx
, len
, i
)
379 new_idx = types_allocate
()
380 len = types_heap
[idx
]["len"]
381 for (i =
1; i
< len
; ++i
) {
382 types_addref
(types_heap
[new_idx
][i
- 1] = types_heap
[idx
][i
])
384 types_heap
[new_idx
]["len"] = len
- 1
388 function core_listp
(idx
)
390 if (types_heap
[idx
]["len"] != 2) {
391 return "!\"Invalid argument length for builtin function 'list?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
393 return types_heap
[idx
][1] ~
/^\
(/ ?
"#true" : "#false"
396 function core_vector
(idx
, new_idx
, len
, i
)
398 new_idx = types_allocate
()
399 len = types_heap
[idx
]["len"]
400 for (i =
1; i
< len
; ++i
) {
401 types_addref
(types_heap
[new_idx
][i
- 1] = types_heap
[idx
][i
])
403 types_heap
[new_idx
]["len"] = len
- 1
407 function core_vectorp
(idx
)
409 if (types_heap
[idx
]["len"] != 2) {
410 return "!\"Invalid argument length for builtin function 'vector?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
412 return types_heap
[idx
][1] ~
/^\
[/ ?
"#true" : "#false"
415 function core_hash_map
(idx
, len
, new_idx
, i
, key
)
417 len = types_heap
[idx
]["len"]
419 return "!\"Invalid argument length for builtin function 'hash-map'. Expects even number of arguments, supplied " (len
- 1) "."
421 new_idx = types_allocate
()
422 for (i =
1; i
< len
; i
+=
2) {
423 key = types_heap
[idx
][i
]
424 if (key !~
/^
[":]/) {
425 types_release("{" new_idx)
426 return "!
\"Incompatible type
for key argument of builtin
function 'hash-map'. Expects string or keyword
, supplied
" types_typename(key) ".
"
428 if (key in types_heap[new_idx]) {
429 types_release(types_heap[new_idx][key])
431 types_addref(types_heap[new_idx][key] = types_heap[idx][i + 1])
436 function core_mapp(idx)
438 if (types_heap[idx]["len
"] != 2) {
439 return "!
\"Invalid argument
length for builtin
function 'map?'. Expects exactly
1 argument
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
441 return types_heap[idx][1] ~ /^\{/ ? "#true" : "#false"
444 function core_assoc
(idx
, len
, map
, i
, key
, add_list
, new_idx
, map_idx
)
446 len = types_heap
[idx
]["len"]
448 return "!\"Invalid argument length for builtin function 'assoc'. Expects odd number of arguments, supplied " (len
- 1) "."
450 map = types_heap
[idx
][1]
452 return "!\"Incompatible type for argument 1 of builtin function 'assoc'. Expects hash-map, supplied " types_typename
(map
) "."
454 for (i =
2; i
< len
; i
+=
2) {
455 key = types_heap
[idx
][i
]
456 if (key !~
/^
[":]/) {
457 return "!
\"Incompatible type
for key argument of builtin
function 'assoc'. Expects string or keyword
, supplied
" types_typename(key) ".
"
459 add_list[key] = types_heap[idx][i + 1]
461 new_idx = types_allocate()
462 map_idx = substr(map, 2)
463 for (key in types_heap[map_idx]) {
464 if (key ~ /^[":]|^meta$
/ && !
(key in add_list
)) {
465 types_addref
(types_heap
[new_idx
][key
] = types_heap
[map_idx
][key
])
468 for (key in add_list
) {
469 types_addref
(types_heap
[new_idx
][key
] = add_list
[key
])
474 function core_dissoc
(idx
, len
, map
, i
, key
, del_list
, new_idx
, map_idx
)
476 len = types_heap
[idx
]["len"]
478 return "!\"Invalid argument length for builtin function 'dissoc'. Expects at least 1 argument, supplied " (len
- 1) "."
480 map = types_heap
[idx
][1]
482 return "!\"Incompatible type for argument 1 of builtin function 'dissoc'. Expects hash-map, supplied " types_typename
(map
) "."
484 for (i =
2; i
< len
; ++i
) {
485 key = types_heap
[idx
][i
]
486 if (key !~
/^
[":]/) {
487 return "!
\"Incompatible type
for key argument of builtin
function 'dissoc'. Expects string or keyword
, supplied
" types_typename(key) ".
"
491 new_idx = types_allocate()
492 map_idx = substr(map, 2)
493 for (key in types_heap[map_idx]) {
494 if (key ~ /^[":]|^meta$
/ && !
(key in del_list
)) {
495 types_addref
(types_heap
[new_idx
][key
] = types_heap
[map_idx
][key
])
501 function core_get
(idx
, map
, key
, map_idx
)
503 if (types_heap
[idx
]["len"] != 3) {
504 return "!\"Invalid argument length for builtin function 'get'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
506 map = types_heap
[idx
][1]
507 if (map !~
/^\
{/ && map
!= "#nil") {
508 return "!\"Incompatible type for argument 1 of builtin function 'get'. Expects hash-map or nil, supplied " types_typename
(map
) "."
510 key = types_heap
[idx
][2]
511 if (key !~
/^
[":]/) {
512 return "!
\"Incompatible type
for argument
2 of builtin
function 'get'. Expects string or keyword
, supplied
" types_typename(key) ".
"
514 if (map != "#nil" && key in types_heap[map_idx = substr(map, 2)]) {
515 return types_addref
(types_heap
[map_idx
][key
])
521 function core_containsp
(idx
, map
, key
)
523 if (types_heap
[idx
]["len"] != 3) {
524 return "!\"Invalid argument length for builtin function 'contains?'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
526 map = types_heap
[idx
][1]
528 return "!\"Incompatible type for argument 1 of builtin function 'contains?'. Expects hash-map, supplied " types_typename
(map
) "."
530 key = types_heap
[idx
][2]
531 if (key !~
/^
[":]/) {
532 return "!
\"Incompatible type
for argument
2 of builtin
function 'contains?'. Expects string or keyword
, supplied
" types_typename(key) ".
"
534 return key in types_heap[substr(map, 2)] ? "#true" : "#false"
537 function core_keys
(idx
, map
, map_idx
, new_idx
, len
, key
)
539 if (types_heap
[idx
]["len"] != 2) {
540 return "!\"Invalid argument length for builtin function 'keys'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
542 map = types_heap
[idx
][1]
544 return "!\"Incompatible type for argument 1 of builtin function 'keys'. Expects hash-map, supplied " types_typename
(map
) "."
546 map_idx =
substr(map
, 2)
547 new_idx = types_allocate
()
549 for (key in types_heap
[map_idx
]) {
551 types_heap[new_idx][len++] = key
554 types_heap[new_idx]["len
"] = len
558 function core_vals(idx, map, map_idx, new_idx, len, key)
560 if (types_heap[idx]["len
"] != 2) {
561 return "!
\"Invalid argument
length for builtin
function 'vals'. Expects exactly
1 argument
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
563 map = types_heap[idx][1]
565 return "!
\"Incompatible type
for argument
1 of builtin
function 'vals'. Expects hash
-map
, supplied
" types_typename(map) ".
"
567 map_idx = substr(map, 2)
568 new_idx = types_allocate()
570 for (key in types_heap[map_idx]) {
572 types_addref
(types_heap
[new_idx
][len
++] = types_heap
[map_idx
][key
])
575 types_heap
[new_idx
]["len"] = len
581 function core_sequentialp
(idx
)
583 if (types_heap
[idx
]["len"] != 2) {
584 return "!\"Invalid argument length for builtin function 'sequential?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
586 return types_heap
[idx
][1] ~
/^
[([]/ ?
"#true" : "#false"
589 function core_cons
(idx
, lst
, lst_idx
, new_idx
, len
, i
)
591 if (types_heap
[idx
]["len"] != 3) {
592 return "!\"Invalid argument length for builtin function 'cons'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
594 lst = types_heap
[idx
][2]
595 if (lst !~
/^
[([]/) {
596 return "!\"Incompatible type for argument 1 of builtin function 'cons'. Expects list or vector, supplied " types_typename
(lst
) "."
598 lst_idx =
substr(lst
, 2)
599 new_idx = types_allocate
()
600 types_addref
(types_heap
[new_idx
][0] = types_heap
[idx
][1])
601 len = types_heap
[lst_idx
]["len"]
602 for (i =
0; i
< len
; ++i
) {
603 types_addref
(types_heap
[new_idx
][i
+ 1] = types_heap
[lst_idx
][i
])
605 types_heap
[new_idx
]["len"] = len
+ 1
609 function core_concat
(idx
, new_idx
, new_len
, len
, i
, lst
, lst_idx
, lst_len
, j
)
611 new_idx = types_allocate
()
613 len = types_heap
[idx
]["len"]
614 for (i =
1; i
< len
; ++i
) {
615 lst = types_heap
[idx
][i
]
616 if (lst !~
/^
[([]/) {
617 types_heap
[new_idx
]["len"] = new_len
618 types_release
("(" new_idx
)
619 return "!\"Incompatible type for argument ' (i - 1) ' of builtin function 'concat'. Expects list or vector, supplied " types_typename
(lst
) "."
621 lst_idx =
substr(lst
, 2)
622 lst_len = types_heap
[lst_idx
]["len"]
623 for (j =
0; j
< lst_len
; ++j
) {
624 types_addref
(types_heap
[new_idx
][new_len
++] = types_heap
[lst_idx
][j
])
627 types_heap
[new_idx
]["len"] = new_len
631 function core_vec
(idx
, new_idx
, len
)
633 len = types_heap
[idx
]["len"]
635 return "!\"Invalid argument length for builtin function 'vec'. Expects exactly 1 argument, supplied " (len
- 1) "."
636 idx = types_heap
[idx
][1]
637 if (idx !~
/^
[([]/) {
638 return "!\"Incompatible type for argument 1 of builtin function 'vec'. Expects list or vector, supplied " types_typename
(idx
) "."
641 len = types_heap
[idx
]["len"]
642 new_idx = types_allocate
()
643 types_heap
[new_idx
]["len"] = len
645 types_addref
(types_heap
[new_idx
][len
] = types_heap
[idx
][len
])
649 function core_nth
(idx
, lst
, num
, n
, lst_idx
)
651 if (types_heap
[idx
]["len"] != 3) {
652 return "!\"Invalid argument length for builtin function 'nth'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
654 lst = types_heap
[idx
][1]
655 if (lst !~
/^
[([]/) {
656 return "!\"Incompatible type for argument 1 of builtin function 'nth'. Expects list or vector, supplied " types_typename
(lst
) "."
658 num = types_heap
[idx
][2]
660 return "!\"Incompatible type for argument 2 of builtin function 'nth'. Expects number, supplied " types_typename
(num
) "."
662 n =
substr(num
, 2) + 0
663 lst_idx =
substr(lst
, 2)
664 if (n
< 0 || types_heap
[lst_idx
]["len"] <= n
) {
665 return "!\"Index out of range. Sequence length is " types_heap
[lst_idx
]["len"] ", supplied " n
"."
667 return types_addref
(types_heap
[lst_idx
][n
])
670 function core_first
(idx
, lst
, lst_idx
)
672 if (types_heap
[idx
]["len"] != 2) {
673 return "!\"Invalid argument length for builtin function 'first'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
675 lst = types_heap
[idx
][1]
679 if (lst !~
/^
[([]/) {
680 return "!\"Incompatible type for argument 1 of builtin function 'first'. Expects list, vector or nil, supplied " types_typename
(lst
) "."
682 lst_idx =
substr(lst
, 2)
683 return types_heap
[lst_idx
]["len"] ==
0 ?
"#nil" : types_addref
(types_heap
[lst_idx
][0])
686 function core_rest
(idx
, lst
, lst_idx
, lst_len
, new_idx
, i
)
688 if (types_heap
[idx
]["len"] != 2) {
689 return "!\"Invalid argument length for builtin function 'rest'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
691 lst = types_heap
[idx
][1]
693 new_idx = types_allocate
()
694 types_heap
[new_idx
]["len"] =
0
697 if (lst !~
/^
[([]/) {
698 return "!\"Incompatible type for argument 1 of builtin function 'rest'. Expects list, vector or nil, supplied " types_typename
(lst
) "."
700 lst_idx =
substr(lst
, 2)
701 lst_len = types_heap
[lst_idx
]["len"]
702 new_idx = types_allocate
()
703 for (i =
1; i
< lst_len
; ++i
) {
704 types_addref
(types_heap
[new_idx
][i
- 1] = types_heap
[lst_idx
][i
])
706 types_heap
[new_idx
]["len"] = lst_len
- 1
710 function core_emptyp
(idx
, lst
)
712 if (types_heap
[idx
]["len"] != 2) {
713 return "!\"Invalid argument length for builtin function 'empty?'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
715 lst = types_heap
[idx
][1]
716 if (lst !~
/^
[([]/) {
717 return "!\"Incompatible type for argument 1 of builtin function 'empty?'. Expects list or vector, supplied " types_typename
(lst
) "."
719 return types_heap
[substr(lst
, 2)]["len"] ==
0 ?
"#true" : "#false"
722 function core_count
(idx
, lst
)
724 if (types_heap
[idx
]["len"] != 2) {
725 return "!\"Invalid argument length for builtin function 'count'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
727 lst = types_heap
[idx
][1]
729 return "+" types_heap
[substr(lst
, 2)]["len"]
734 return "!\"Incompatible type for argument 1 of builtin function 'count'. Expects list, vector or nil, supplied " types_typename
(lst
) "."
737 function core_apply
(idx
, len
, f
, lst
, new_idx
, i
, lst_idx
, lst_len
, f_idx
, env
, ret
)
739 len = types_heap
[idx
]["len"]
741 return "!\"Invalid argument length for builtin function 'apply'. Expects at least 2 arguments, supplied " (len
- 1) "."
743 f = types_heap
[idx
][1]
745 return "!\"Incompatible type for argument 1 of builtin function 'apply'. Expects function, supplied " types_typename
(f
) "."
747 lst = types_heap
[idx
][len
- 1]
748 if (lst !~
/^
[([]/) {
749 return "!\"Incompatible type for argument ' (len - 1) ' of builtin function 'apply'. Expects list or vector, supplied " types_typename
(lst
) "."
752 new_idx = types_allocate
()
753 types_addref
(types_heap
[new_idx
][0] = f
)
754 for (i =
2; i
< len
- 1; ++i
) {
755 types_addref
(types_heap
[new_idx
][i
- 1] = types_heap
[idx
][i
])
757 lst_idx =
substr(lst
, 2)
758 lst_len = types_heap
[lst_idx
]["len"]
759 for (i =
0; i
< lst_len
; ++i
) {
760 types_addref
(types_heap
[new_idx
][len
+ i
- 2] = types_heap
[lst_idx
][i
])
762 types_heap
[new_idx
]["len"] = len
+ lst_len
- 2
767 env = env_new
(types_heap
[f_idx
]["env"], types_heap
[f_idx
]["params"], new_idx
)
768 types_release
("(" new_idx
)
772 ret = EVAL
(types_addref
(types_heap
[f_idx
]["body"]), env
)
776 f_idx = types_heap
[f_idx
]["func"]
778 ret = @f_idx
(new_idx
)
779 types_release
("(" new_idx
)
784 function core_map
(idx
, f
, lst
, f_idx
, lst_idx
, lst_len
, new_idx
, expr_idx
, i
, env
, ret
, val
)
786 if (types_heap
[idx
]["len"] != 3) {
787 return "!\"Invalid argument length for builtin function 'map'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
789 f = types_heap
[idx
][1]
791 return "!\"Incompatible type for argument 1 of builtin function 'map'. Expects function, supplied " types_typename
(f
) "."
793 lst = types_heap
[idx
][2]
794 if (lst !~
/^
[([]/) {
795 return "!\"Incompatible type for argument 2 of builtin function 'map'. Expects list or vector, supplied " types_typename
(lst
) "."
798 lst_idx =
substr(lst
, 2)
799 lst_len = types_heap
[lst_idx
]["len"]
800 new_idx = types_allocate
()
801 types_heap
[new_idx
][0] = f
802 types_heap
[new_idx
]["len"] =
2
803 expr_idx = types_allocate
()
804 for (i =
0; i
< lst_len
; ++i
) {
805 types_heap
[new_idx
][1] = types_heap
[lst_idx
][i
]
808 env = env_new
(types_heap
[f_idx
]["env"], types_heap
[f_idx
]["params"], new_idx
)
810 types_heap
[expr_idx
]["len"] = i
811 types_heap
[new_idx
]["len"] =
0
812 types_release
("(" expr_idx
)
813 types_release
("(" new_idx
)
816 ret = EVAL
(types_addref
(types_heap
[f_idx
]["body"]), env
)
820 f_idx = types_heap
[f_idx
]["func"]
822 ret = @f_idx
(new_idx
)
826 types_heap
[expr_idx
]["len"] = i
827 types_heap
[new_idx
]["len"] =
0
828 types_release
("(" expr_idx
)
829 types_release
("(" new_idx
)
832 types_heap
[expr_idx
][i
] = ret
834 types_heap
[expr_idx
]["len"] = lst_len
835 types_heap
[new_idx
]["len"] =
0
836 types_release
("(" new_idx
)
842 function core_conj
(idx
, len
, lst
, lst_idx
, lst_len
, new_idx
, i
, j
)
844 len = types_heap
[idx
]["len"]
846 return "!\"Invalid argument length for builtin function 'conj'. Expects at least 2 arguments, supplied " (len
- 1) "."
848 lst = types_heap
[idx
][1]
849 if (lst !~
/^
[([]/) {
850 return "!\"Incompatible type for argument 1 of builtin function 'conj'. Expects list or vector, supplied " types_typename
(lst
) "."
852 lst_idx =
substr(lst
, 2)
853 lst_len = types_heap
[lst_idx
]["len"]
854 new_idx = types_allocate
()
857 for (i = len
- 1; i
>=
2; --i
) {
858 types_addref
(types_heap
[new_idx
][j
++] = types_heap
[idx
][i
])
860 for (i =
0; i
< lst_len
; ++i
) {
861 types_addref
(types_heap
[new_idx
][j
++] = types_heap
[lst_idx
][i
])
864 for (i =
0; i
< lst_len
; ++i
) {
865 types_addref
(types_heap
[new_idx
][j
++] = types_heap
[lst_idx
][i
])
867 for (i =
2; i
< len
; ++i
) {
868 types_addref
(types_heap
[new_idx
][j
++] = types_heap
[idx
][i
])
871 types_addref
(types_heap
[new_idx
]["meta"] = types_heap
[lst_idx
]["meta"])
872 types_heap
[new_idx
]["len"] = j
873 return substr(lst
, 1, 1) new_idx
876 function core_seq
(idx
, obj
, obj_idx
, new_idx
, i
, len
, chars
)
878 if (types_heap
[idx
]["len"] != 2) {
879 return "!\"Invalid argument length for builtin function 'seq'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
881 obj = types_heap
[idx
][1]
883 if (types_heap
[substr(obj
, 2)]["len"] ==
0) {
886 return types_addref
(obj
)
887 } else if (obj ~
/^\
[/) {
888 obj_idx =
substr(obj
, 2)
889 len = types_heap
[obj_idx
]["len"]
890 if (len ==
0) { return "#nil" }
891 new_idx = types_allocate
()
892 for (i =
0; i
< len
; ++i
) {
893 types_addref
(types_heap
[new_idx
][i
] = types_heap
[obj_idx
][i
])
895 types_heap
[new_idx
]["len"] = len
897 } else if (obj ~
/^
"/) {
898 obj_idx = substr(obj, 2)
899 len = length(obj_idx)
900 if (len == 0) { return "#nil" }
901 new_idx = types_allocate
()
902 split(obj_idx
, chars
, "")
903 for (i =
0; i
<= len
; ++i
) {
904 types_heap
[new_idx
][i
] =
"\"" chars
[i
+1]
906 types_heap
[new_idx
]["len"] = len
908 } else if (obj ==
"#nil") {
911 return "!\"seq: called on non-sequence"
916 function core_meta
(idx
, obj
, obj_idx
)
918 if (types_heap
[idx
]["len"] != 2) {
919 return "!\"Invalid argument length for builtin function 'meta'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
921 obj = types_heap
[idx
][1]
922 if (obj ~
/^
[([{$%
]/ && "meta" in types_heap
[obj_idx =
substr(obj
, 2)]) {
923 return types_addref
(types_heap
[obj_idx
]["meta"])
928 function core_with_meta
(idx
, obj
, obj_idx
, new_idx
, i
, len
)
930 if (types_heap
[idx
]["len"] != 3) {
931 return "!\"Invalid argument length for builtin function 'with-meta'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
933 obj = types_heap
[idx
][1]
934 obj_idx =
substr(obj
, 2)
935 new_idx = types_allocate
()
936 types_addref
(types_heap
[new_idx
]["meta"] = types_heap
[idx
][2])
939 len = types_heap
[obj_idx
]["len"]
940 for (i =
0; i
< len
; ++i
) {
941 types_addref
(types_heap
[new_idx
][i
] = types_heap
[obj_idx
][i
])
943 types_heap
[new_idx
]["len"] = len
944 return substr(obj
, 1, 1) new_idx
946 for (i in types_heap
[obj_idx
]) {
948 types_addref(types_heap[new_idx][i] = types_heap[obj_idx][i])
953 types_addref(types_heap[new_idx]["params
"] = types_heap[obj_idx]["params
"])
954 types_addref(types_heap[new_idx]["body
"] = types_heap[obj_idx]["body
"])
955 env_addref(types_heap[new_idx]["env
"] = types_heap[obj_idx]["env
"])
958 types_heap[new_idx]["func
"] = obj_idx
961 types_heap
[new_idx
]["func"] = types_heap
[obj_idx
]["func"]
964 types_release("{" new_idx)
965 return "!
\"Incompatible type
for argument
1 of builtin
function 'with-meta'. Expects list
, vector
, hash
-map or
function, supplied
" types_typename(lst) ".
"
969 function core_atom(idx, atom_idx)
971 if (types_heap[idx]["len
"] != 2) {
972 return "!
\"Invalid argument
length for builtin
function 'atom'. Expects exactly
1 argument
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
974 atom_idx = types_allocate()
975 types_addref(types_heap[atom_idx]["obj
"] = types_heap[idx][1])
979 function core_atomp(idx)
981 if (types_heap[idx]["len
"] != 2) {
982 return "!
\"Invalid argument
length for builtin
function 'atom?'. Expects exactly
1 argument
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
984 return types_heap[idx][1] ~ /^\?/ ? "#true" : "#false"
987 function core_deref
(idx
, atom
)
989 if (types_heap
[idx
]["len"] != 2) {
990 return "!\"Invalid argument length for builtin function 'deref'. Expects exactly 1 argument, supplied " (types_heap
[idx
]["len"] - 1) "."
992 atom = types_heap
[idx
][1]
994 return "!\"Incompatible type for argument 1 of builtin function 'deref'. Expects atom, supplied " types_typename
(atom
) "."
996 return types_addref
(types_heap
[substr(atom
, 2)]["obj"])
999 function core_reset
(idx
, atom
, atom_idx
)
1001 if (types_heap
[idx
]["len"] != 3) {
1002 return "!\"Invalid argument length for builtin function 'reset!'. Expects exactly 2 arguments, supplied " (types_heap
[idx
]["len"] - 1) "."
1004 atom = types_heap
[idx
][1]
1005 if (atom !~
/^
\?/) {
1006 return "!\"Incompatible type for argument 1 of builtin function 'reset!'. Expects atom, supplied " types_typename
(atom
) "."
1008 atom_idx =
substr(atom
, 2)
1009 types_release
(types_heap
[atom_idx
]["obj"])
1010 return types_addref
(types_heap
[atom_idx
]["obj"] = types_heap
[idx
][2])
1013 function core_swap
(idx
, expr
, atom
, f
, lst_idx
, ret
, f_idx
, env
, i
, len
, atom_idx
)
1015 len = types_heap
[idx
]["len"]
1017 return "!\"Invalid argument length for builtin function 'swap!'. Expects at least 2 arguments, supplied " (len
- 1) "."
1019 atom = types_heap
[idx
][1]
1020 if (atom !~
/^
\?/) {
1021 return "!\"Incompatible type for argument 1 of builtin function 'swap!'. Expects atom, supplied " types_typename
(atom
) "."
1023 f = types_heap
[idx
][2]
1024 if (f !~
/^
[&$%
]/) {
1025 return "!\"Incompatible type for argument 2 of builtin function 'swap!'. Expects function, supplied " types_typename
(f
) "."
1027 lst_idx = types_allocate
()
1028 atom_idx =
substr(atom
, 2)
1029 types_addref
(types_heap
[lst_idx
][0] = f
)
1030 types_addref
(types_heap
[lst_idx
][1] = types_heap
[atom_idx
]["obj"])
1031 for (i =
3; i
< len
; ++i
) {
1032 types_addref
(types_heap
[lst_idx
][i
- 1] = types_heap
[idx
][i
])
1034 types_heap
[lst_idx
]["len"] = len
- 1
1036 f_idx =
substr(f
, 2)
1039 env = env_new
(types_heap
[f_idx
]["env"], types_heap
[f_idx
]["params"], lst_idx
)
1040 types_release
("(" lst_idx
)
1044 ret = EVAL
(types_addref
(types_heap
[f_idx
]["body"]), env
)
1048 f_idx = types_heap
[f_idx
]["func"]
1050 ret = @f_idx
(lst_idx
)
1051 types_release
("(" lst_idx
)
1058 types_release
(types_heap
[atom_idx
]["obj"])
1059 return types_addref
(types_heap
[atom_idx
]["obj"] = ret
)
1062 function core_init
()
1064 core_ns
["'="] =
"&core_eq"
1065 core_ns
["'throw"] =
"&core_throw"
1067 core_ns
["'nil?"] =
"&core_nilp"
1068 core_ns
["'true?"] =
"&core_truep"
1069 core_ns
["'false?"] =
"&core_falsep"
1070 core_ns
["'string?"] =
"&core_stringp"
1071 core_ns
["'symbol"] =
"&core_symbol"
1072 core_ns
["'symbol?"] =
"&core_symbolp"
1073 core_ns
["'keyword"] =
"&core_keyword"
1074 core_ns
["'keyword?"] =
"&core_keywordp"
1075 core_ns
["'number?"] =
"&core_numberp"
1076 core_ns
["'fn?"] =
"&core_fnp"
1077 core_ns
["'macro?"] =
"&core_macrop"
1079 core_ns
["'pr-str"] =
"&core_pr_str"
1080 core_ns
["'str"] =
"&core_str"
1081 core_ns
["'prn"] =
"&core_prn"
1082 core_ns
["'println"] =
"&core_println"
1083 core_ns
["'read-string"] =
"&core_read_string"
1084 core_ns
["'readline"] =
"&core_readline"
1085 core_ns
["'slurp"] =
"&core_slurp"
1087 core_ns
["'<"] =
"&core_lt"
1088 core_ns
["'<="] =
"&core_le"
1089 core_ns
["'>"] =
"&core_gt"
1090 core_ns
["'>="] =
"&core_ge"
1091 core_ns
["'+"] =
"&core_add"
1092 core_ns
["'-"] =
"&core_subtract"
1093 core_ns
["'*"] =
"&core_multiply"
1094 core_ns
["'/"] =
"&core_divide"
1095 core_ns
["'time-ms"] =
"&core_time_ms"
1097 core_ns
["'list"] =
"&core_list"
1098 core_ns
["'list?"] =
"&core_listp"
1099 core_ns
["'vec"] =
"&core_vec"
1100 core_ns
["'vector"] =
"&core_vector"
1101 core_ns
["'vector?"] =
"&core_vectorp"
1102 core_ns
["'hash-map"] =
"&core_hash_map"
1103 core_ns
["'map?"] =
"&core_mapp"
1104 core_ns
["'assoc"] =
"&core_assoc"
1105 core_ns
["'dissoc"] =
"&core_dissoc"
1106 core_ns
["'get"] =
"&core_get"
1107 core_ns
["'contains?"] =
"&core_containsp"
1108 core_ns
["'keys"] =
"&core_keys"
1109 core_ns
["'vals"] =
"&core_vals"
1111 core_ns
["'sequential?"] =
"&core_sequentialp"
1112 core_ns
["'cons"] =
"&core_cons"
1113 core_ns
["'concat"] =
"&core_concat"
1114 core_ns
["'nth"] =
"&core_nth"
1115 core_ns
["'first"] =
"&core_first"
1116 core_ns
["'rest"] =
"&core_rest"
1117 core_ns
["'empty?"] =
"&core_emptyp"
1118 core_ns
["'count"] =
"&core_count"
1119 core_ns
["'apply"] =
"&core_apply"
1120 core_ns
["'map"] =
"&core_map"
1122 core_ns
["'conj"] =
"&core_conj"
1123 core_ns
["'seq"] =
"&core_seq"
1125 core_ns
["'meta"] =
"&core_meta"
1126 core_ns
["'with-meta"] =
"&core_with_meta"
1127 core_ns
["'atom"] =
"&core_atom"
1128 core_ns
["'atom?"] =
"&core_atomp"
1129 core_ns
["'deref"] =
"&core_deref"
1130 core_ns
["'reset!"] =
"&core_reset"
1131 core_ns
["'swap!"] =
"&core_swap"