9 return reader_read_str
(str
)
14 return ast ~
/^
[([]/ && types_heap
[substr(ast
, 2)]["len"] != 0
17 function quasiquote
(ast
, i
, len
, new_idx
, idx
, lst_idx
, first
, first_idx
, verb
, ret
)
20 new_idx = types_allocate
()
21 types_heap
[new_idx
][0] =
"'quote"
22 types_heap
[new_idx
][1] = ast
23 types_heap
[new_idx
]["len"] =
2
27 first = types_heap
[idx
][0]
28 if (first ==
"'unquote") {
29 if (types_heap
[idx
]["len"] != 2) {
30 len = types_heap
[idx
]["len"]
32 return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len
- 1) "."
34 types_addref
(ret = types_heap
[idx
][1])
39 first_idx =
substr(first
, 2)
40 if (is_pair
(first
) && types_heap
[first_idx
][0] ==
"'splice-unquote") {
41 if (types_heap
[first_idx
]["len"] != 2) {
42 len = types_heap
[first_idx
]["len"]
44 return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len
- 1) "."
46 types_addref
(first = types_heap
[first_idx
][1])
50 first = quasiquote
(first
)
57 lst_idx = types_allocate
()
58 len = types_heap
[idx
]["len"]
59 for (i =
1; i
< len
; ++i
) {
60 types_addref
(types_heap
[lst_idx
][i
- 1] = types_heap
[idx
][i
])
62 types_heap
[lst_idx
]["len"] = len
- 1
64 ret = quasiquote
("(" lst_idx
)
70 new_idx = types_allocate
()
71 types_heap
[new_idx
][0] = verb
72 types_heap
[new_idx
][1] = first
73 types_heap
[new_idx
][2] = ret
74 types_heap
[new_idx
]["len"] =
3
78 function eval_ast
(ast
, env
, i
, idx
, len
, new_idx
, ret
)
82 ret = env_get(env, ast)
89 len = types_heap[idx]["len"]
90 new_idx = types_allocate()
91 for (i = 0; i < len; ++i) {
92 ret = EVAL(types_addref(types_heap[idx][i]), env)
94 types_heap[new_idx]["len"] = i
95 types_release(substr(ast, 1, 1) new_idx)
98 types_heap[new_idx][i] = ret
100 types_heap[new_idx]["len"] = len
101 return substr(ast, 1, 1) new_idx
104 new_idx = types_allocate()
105 for (i in types_heap[idx]) {
107 ret = EVAL(types_addref(types_heap[idx][i]), env)
109 types_release("{" new_idx)
112 types_heap[new_idx][i] = ret
121 function EVAL_def(ast, env, idx, sym, ret, len)
124 if (types_heap[idx]["len"] != 3) {
125 len = types_heap[idx]["len"]
128 return "!\"Invalid argument length for 'def!
'. Expects exactly 2 arguments, supplied" (len - 1) "."
130 sym = types_heap[idx][1]
134 return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename
(sym
) "."
136 ret = EVAL
(types_addref
(types_heap
[idx
][2]), env
)
138 env_set
(env
, sym
, ret
)
146 function EVAL_let
(ast
, env
, ret_env
, idx
, params
, params_idx
, params_len
, new_env
, i
, sym
, ret
, body
, len
)
149 if (types_heap
[idx
]["len"] != 3) {
150 len = types_heap
[idx
]["len"]
153 return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len
- 1) "."
155 params = types_heap
[idx
][1]
156 if (params !~
/^
[([]/) {
159 return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename
(params
) "."
161 params_idx =
substr(params
, 2)
162 params_len = types_heap
[params_idx
]["len"]
163 if (params_len %
2 != 0) {
166 return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len
"."
168 new_env = env_new
(env
)
170 for (i =
0; i
< params_len
; i
+=
2) {
171 sym = types_heap
[params_idx
][i
]
175 return "!\"Incompatible type for odd element of argument 1 of 'let
*'. Expects symbol, supplied " types_typename(sym) "."
177 ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env)
183 env_set(new_env, sym, ret)
185 types_addref(body = types_heap[idx][2])
191 function EVAL_do(ast, env, idx, len, i, body, ret)
194 len = types_heap[idx]["len"]
198 return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "."
200 for (i = 1; i < len - 1; ++i) {
201 ret = EVAL(types_addref(types_heap[idx][i]), env)
209 types_addref(body = types_heap[idx][len - 1])
214 function EVAL_if(ast, env, idx, len, ret, body)
217 len = types_heap[idx]["len"]
218 if (len != 3 && len != 4) {
220 return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "."
222 ret = EVAL(types_addref(types_heap[idx][1]), env)
234 types_addref(body = types_heap[idx][3])
238 types_addref(body = types_heap[idx][2])
245 function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len)
248 if (types_heap[idx]["len"] != 3) {
249 len = types_heap[idx]["len"]
252 return "!\"Invalid argument length for 'fn
*'. Expects exactly 2 arguments, supplied " (len - 1) "."
254 params = types_heap[idx][1]
255 if (params !~ /^[([]/) {
258 return "!\"Incompatible type for argument 1 of 'fn
*'. Expects list or vector, supplied " types_typename(params) "."
260 params_idx = substr(params, 2)
261 params_len = types_heap[params_idx]["len"]
262 for (i = 0; i < params_len; ++i) {
263 sym = types_heap[params_idx][i]
267 return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename
(sym
) "."
269 if (sym ==
"'&" && i
+ 2 != params_len
) {
272 return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len
", position of symbol '&' is " (i
+ 1) "."
275 f_idx = types_allocate
()
276 types_addref
(types_heap
[f_idx
]["params"] = types_heap
[idx
][1])
277 types_addref
(types_heap
[f_idx
]["body"] = types_heap
[idx
][2])
278 types_heap
[f_idx
]["env"] = env
283 function EVAL
(ast
, env
, body
, new_ast
, ret
, idx
, len
, f
, f_idx
, ret_env
)
288 ret = eval_ast
(ast
, env
)
294 len = types_heap
[idx
]["len"]
299 switch
(types_heap
[idx
][0]) {
301 return EVAL_def
(ast
, env
)
303 ast = EVAL_let
(ast
, env
, ret_env
)
313 return "!\"Invalid argument length for 'quote'. Expects exactly 1 argument, supplied " (len
- 1) "."
315 types_addref
(body = types_heap
[idx
][1])
323 return "!\"Invalid argument length for 'quasiquote'. Expects exactly 1 argument, supplied " (len
- 1) "."
325 types_addref
(body = types_heap
[idx
][1])
327 ast = quasiquote
(body
)
334 ast = EVAL_do
(ast
, env
)
340 ast = EVAL_if
(ast
, env
)
341 if (ast !~
/^
['([{]/) {
347 return EVAL_fn(ast, env)
349 new_ast = eval_ast(ast, env)
352 if (new_ast ~ /^!/) {
355 idx = substr(new_ast, 2)
356 f = types_heap[idx][0]
360 env = env_new(types_heap[f_idx]["env
"], types_heap[f_idx]["params
"], idx)
362 types_release(new_ast)
365 types_addref(ast = types_heap[f_idx]["body
"])
366 types_release(new_ast)
370 types_release(new_ast)
373 types_release(new_ast)
374 return "!
\"First element of list must be
function, supplied
" types_typename(f) ".
"
380 function PRINT(expr, str)
382 str = printer_pr_str(expr, 1)
387 function rep(str, ast, expr)
393 expr = EVAL(ast, repl_env)
402 if (types_heap[idx]["len
"] != 2) {
403 return "!
\"Invalid argument
length for builtin
function 'eval'. Expects exactly
1 argument
, supplied
" (types_heap[idx]["len
"] - 1) ".
"
405 return EVAL(types_addref(types_heap[idx][1]), repl_env)
408 function main(str, ret, i, idx)
412 env_set(repl_env, i, core_ns[i])
415 env_set(repl_env, "'eval", "&eval")
417 rep("(def! not (fn* (a) (if a false true)))")
418 rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
420 idx = types_allocate()
421 env_set(repl_env, "'*ARGV*", "(" idx)
423 for (i = 2; i < ARGC; ++i) {
424 types_heap[idx][i - 2] = "\"" ARGV[i]
426 types_heap[idx]["len
"] = ARGC - 2
428 rep("(load
-file
\"" ARGV[1] "\")")
431 types_heap[idx]["len
"] = 0
435 if (getline str <= 0) {
440 print "ERROR
: " printer_pr_str(substr(ret, 2))