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 is_macro_call
(ast
, env
, sym
, ret
, f
)
83 sym = types_heap
[substr(ast
, 2)][0]
88 return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
91 function macroexpand(ast, env, idx, f_idx, new_env)
93 while (is_macro_call(ast, env)) {
95 f_idx = substr(env_get(env, types_heap[idx][0]), 2)
96 new_env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx)
101 types_addref(ast = types_heap[f_idx]["body"])
102 ast = EVAL(ast, new_env)
111 function eval_ast(ast, env, i, idx, len, new_idx, ret)
115 ret = env_get
(env
, ast
)
122 len = types_heap
[idx
]["len"]
123 new_idx = types_allocate
()
124 for (i =
0; i
< len
; ++i
) {
125 ret = EVAL
(types_addref
(types_heap
[idx
][i
]), env
)
127 types_heap
[new_idx
]["len"] = i
128 types_release
(substr(ast
, 1, 1) new_idx
)
131 types_heap
[new_idx
][i
] = ret
133 types_heap
[new_idx
]["len"] = len
134 return substr(ast
, 1, 1) new_idx
137 new_idx = types_allocate
()
138 for (i in types_heap
[idx
]) {
140 ret = EVAL(types_addref(types_heap[idx][i]), env)
142 types_release("{" new_idx)
145 types_heap[new_idx][i] = ret
154 function EVAL_def(ast, env, idx, sym, ret, len)
157 if (types_heap[idx]["len
"] != 3) {
158 len = types_heap[idx]["len
"]
161 return "!
\"Invalid argument
length for 'def!'. Expects exactly
2 arguments
, supplied
" (len - 1) ".
"
163 sym = types_heap[idx][1]
167 return "!
\"Incompatible type
for argument
1 of
'def!'. Expects symbol
, supplied
" types_typename(sym) ".
"
169 ret = EVAL(types_addref(types_heap[idx][2]), env)
171 env_set(env, sym, ret)
179 function EVAL_let(ast, env, ret_env, idx, params, params_idx, params_len, new_env, i, sym, ret, body, len)
182 if (types_heap[idx]["len
"] != 3) {
183 len = types_heap[idx]["len
"]
186 return "!
\"Invalid argument
length for 'let*'. Expects exactly
2 arguments
, supplied
" (len - 1) ".
"
188 params = types_heap[idx][1]
189 if (params !~ /^[([]/) {
192 return "!
\"Incompatible type
for argument
1 of
'let*'. Expects list or vector
, supplied
" types_typename(params) ".
"
194 params_idx = substr(params, 2)
195 params_len = types_heap[params_idx]["len
"]
196 if (params_len % 2 != 0) {
199 return "!
\"Invalid elements count
for argument
1 of
'let*'. Expects even number of elements
, supplied
" params_len ".
"
201 new_env = env_new(env)
203 for (i = 0; i < params_len; i += 2) {
204 sym = types_heap[params_idx][i]
208 return "!
\"Incompatible type
for odd element of argument
1 of
'let*'. Expects symbol
, supplied
" types_typename(sym) ".
"
210 ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env)
216 env_set(new_env, sym, ret)
218 types_addref(body = types_heap[idx][2])
224 function EVAL_defmacro(ast, env, idx, sym, ret, len)
227 if (types_heap[idx]["len
"] != 3) {
228 len = types_heap[idx]["len
"]
231 return "!
\"Invalid argument
length for 'defmacro!'. Expects exactly
2 arguments
, supplied
" (len - 1) ".
"
233 sym = types_heap[idx][1]
237 return "!
\"Incompatible type
for argument
1 of
'defmacro!'. Expects symbol
, supplied
" types_typename(sym) ".
"
239 ret = EVAL(types_addref(types_heap[idx][2]), env)
248 return "!
\"Incompatible type
for argument
2 of
'defmacro!'. Expects
function, supplied
" types_typename(ret) ".
"
250 types_heap[substr(ret, 2)]["is_macro
"] = 1
251 env_set(env, sym, ret)
257 function EVAL_do(ast, env, idx, len, i, body, ret)
260 len = types_heap[idx]["len
"]
264 return "!
\"Invalid argument
length for 'do'. Expects at least
1 argument
, supplied
" (len - 1) ".
"
266 for (i = 1; i < len - 1; ++i) {
267 ret = EVAL(types_addref(types_heap[idx][i]), env)
275 types_addref(body = types_heap[idx][len - 1])
280 function EVAL_if(ast, env, idx, len, ret, body)
283 len = types_heap[idx]["len
"]
284 if (len != 3 && len != 4) {
286 return "!
\"Invalid argument
length for 'if'. Expects
2 or
3 arguments
, supplied
" (len - 1) ".
"
288 ret = EVAL(types_addref(types_heap[idx][1]), env)
300 types_addref
(body = types_heap
[idx
][3])
304 types_addref
(body = types_heap
[idx
][2])
311 function EVAL_fn
(ast
, env
, idx
, params
, params_idx
, params_len
, i
, sym
, f_idx
, len
)
314 if (types_heap
[idx
]["len"] != 3) {
315 len = types_heap
[idx
]["len"]
318 return "!\"Invalid argument length for 'fn*'. Expects exactly 2 arguments, supplied " (len
- 1) "."
320 params = types_heap
[idx
][1]
321 if (params !~
/^
[([]/) {
324 return "!\"Incompatible type for argument 1 of 'fn*'. Expects list or vector, supplied " types_typename
(params
) "."
326 params_idx =
substr(params
, 2)
327 params_len = types_heap
[params_idx
]["len"]
328 for (i =
0; i
< params_len
; ++i
) {
329 sym = types_heap
[params_idx
][i
]
333 return "!\"Incompatible type for element of argument 1 of 'fn
*'. Expects symbol, supplied " types_typename(sym) "."
335 if (sym == "'&" && i + 2 != params_len) {
338 return "!
\"Symbol
'&' should be followed by last parameter. Parameter list
length is
" params_len ", position of symbol
'&' is
" (i + 1) ".
"
341 f_idx = types_allocate()
342 types_addref(types_heap[f_idx]["params
"] = types_heap[idx][1])
343 types_addref(types_heap[f_idx]["body
"] = types_heap[idx][2])
344 types_heap[f_idx]["env
"] = env
349 function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env)
354 ret = eval_ast(ast, env)
359 if (types_heap[substr(ast, 2)]["len
"] == 0) {
363 ast = macroexpand(ast, env)
369 ret = eval_ast(ast, env)
375 len = types_heap[idx]["len
"]
376 switch (types_heap[idx][0]) {
378 return EVAL_def(ast, env)
380 ast = EVAL_let(ast, env, ret_env)
390 return "!\"Invalid argument length for 'quote
'. Expects exactly 1 argument, supplied " (len - 1) "."
392 types_addref(body = types_heap[idx][1])
400 return "!
\"Invalid argument
length for 'quasiquote'. Expects exactly
1 argument
, supplied
" (len - 1) ".
"
402 types_addref(body = types_heap[idx][1])
404 ast = quasiquote(body)
411 return EVAL_defmacro(ast, env)
416 return "!
\"Invalid argument
length for 'macroexpand'. Expects exactly
1 argument
, supplied
" (len - 1) ".
"
418 types_addref(body = types_heap[idx][1])
420 ret = macroexpand(body, env)
424 ast = EVAL_do(ast, env)
430 ast = EVAL_if(ast, env)
431 if (ast !~ /^['([{]/) {
437 return EVAL_fn(ast, env)
439 new_ast = eval_ast(ast, env)
442 if (new_ast ~ /^!/) {
445 idx = substr(new_ast, 2)
446 f = types_heap[idx][0]
450 env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx)
452 types_release(new_ast)
455 types_addref(ast = types_heap[f_idx]["body"])
456 types_release(new_ast)
460 types_release(new_ast)
463 types_release(new_ast)
464 return "!\"First element of list must be function, supplied " types_typename(f) "."
470 function PRINT(expr, str)
472 str = printer_pr_str(expr, 1)
477 function rep(str, ast, expr)
483 expr = EVAL(ast, repl_env)
492 if (types_heap[idx]["len"] != 2) {
493 return "!\"Invalid argument length for builtin function 'eval
'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
495 return EVAL(types_addref(types_heap[idx][1]), repl_env)
498 function main(str, ret, i, idx)
502 env_set(repl_env, i, core_ns[i])
505 env_set(repl_env, "'eval
", "&eval
")
507 rep("(def! not
(fn
* (a
) (if a false true
)))")
508 rep("(def! load
-file
(fn
* (f
) (eval
(read
-string
(str
\"(do \" (slurp f
) \"\\nnil
)\")))))")
509 rep("(defmacro! cond
(fn
* (& xs
) (if (> (count xs
) 0) (list
'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond
(rest
(rest xs
)))))))")
511 idx = types_allocate()
512 env_set(repl_env, "'*ARGV*", "(" idx)
514 for (i = 2; i < ARGC; ++i) {
515 types_heap[idx][i - 2] = "\"" ARGV[i]
517 types_heap[idx]["len"] = ARGC - 2
519 rep("(load-file \"" ARGV[1] "\")")
522 types_heap[idx]["len"] = 0
526 if (getline str <= 0) {
531 print "ERROR: " printer_pr_str(substr(ret, 2))