9 return reader_read_str
(str
)
12 function eval_ast
(ast
, env
, i
, idx
, len
, new_idx
, ret
)
16 ret = env_get(env, ast)
23 len = types_heap[idx]["len"]
24 new_idx = types_allocate()
25 for (i = 0; i < len; ++i) {
26 ret = EVAL(types_addref(types_heap[idx][i]), env)
28 types_heap[new_idx]["len"] = i
29 types_release(substr(ast, 1, 1) new_idx)
32 types_heap[new_idx][i] = ret
34 types_heap[new_idx]["len"] = len
35 return substr(ast, 1, 1) new_idx
38 new_idx = types_allocate()
39 for (i in types_heap[idx]) {
41 ret = EVAL(types_addref(types_heap[idx][i]), env)
43 types_release("{" new_idx)
46 types_heap[new_idx][i] = ret
55 function EVAL_def(ast, env, idx, sym, ret, len)
58 if (types_heap[idx]["len"] != 3) {
59 len = types_heap[idx]["len"]
62 return "!\"Invalid argument length for 'def!
'. Expects exactly 2 arguments, supplied" (len - 1) "."
64 sym = types_heap[idx][1]
68 return "!\"Incompatible type for argument 1 of 'def!'. Expects symbol, supplied " types_typename
(sym
) "."
70 ret = EVAL
(types_addref
(types_heap
[idx
][2]), env
)
72 env_set
(env
, sym
, ret
)
80 function EVAL_let
(ast
, env
, idx
, params
, params_idx
, params_len
, new_env
, i
, sym
, ret
, body
, len
)
83 if (types_heap
[idx
]["len"] != 3) {
84 len = types_heap
[idx
]["len"]
87 return "!\"Invalid argument length for 'let*'. Expects exactly 2 arguments, supplied " (len
- 1) "."
89 params = types_heap
[idx
][1]
90 if (params !~
/^
[([]/) {
93 return "!\"Incompatible type for argument 1 of 'let*'. Expects list or vector, supplied " types_typename
(params
) "."
95 params_idx =
substr(params
, 2)
96 params_len = types_heap
[params_idx
]["len"]
97 if (params_len %
2 != 0) {
100 return "!\"Invalid elements count for argument 1 of 'let*'. Expects even number of elements, supplied " params_len
"."
102 new_env = env_new
(env
)
104 for (i =
0; i
< params_len
; i
+=
2) {
105 sym = types_heap
[params_idx
][i
]
109 return "!\"Incompatible type for odd element of argument 1 of 'let
*'. Expects symbol, supplied " types_typename(sym) "."
111 ret = EVAL(types_addref(types_heap[params_idx][i + 1]), new_env)
117 env_set(new_env, sym, ret)
119 types_addref(body = types_heap[idx][2])
121 ret = EVAL(body, new_env)
126 function EVAL_do(ast, env, idx, len, i, ret)
129 len = types_heap[idx]["len"]
133 return "!\"Invalid argument length for 'do'. Expects at least 1 argument, supplied" (len - 1) "."
135 for (i = 1; i < len - 1; ++i) {
136 ret = EVAL(types_addref(types_heap[idx][i]), env)
144 ret = EVAL(types_addref(types_heap[idx][len - 1]), env)
150 function EVAL_if(ast, env, idx, len, ret, body)
153 len = types_heap[idx]["len"]
154 if (len != 3 && len != 4) {
157 return "!\"Invalid argument length for 'if'. Expects 2 or 3 arguments, supplied " (len - 1) "."
159 ret = EVAL(types_addref(types_heap[idx][1]), env)
174 types_addref(body = types_heap[idx][3])
178 types_addref(body = types_heap[idx][2])
181 ret = EVAL(body, env)
187 function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx, len)
190 if (types_heap[idx]["len"] != 3) {
191 len = types_heap[idx]["len"]
194 return "!\"Invalid argument length for 'fn
*'. Expects exactly 2 arguments, supplied " (len - 1) "."
196 params = types_heap[idx][1]
197 if (params !~ /^[([]/) {
200 return "!\"Incompatible type for argument 1 of 'fn
*'. Expects list or vector, supplied " types_typename(params) "."
202 params_idx = substr(params, 2)
203 params_len = types_heap[params_idx]["len"]
204 for (i = 0; i < params_len; ++i) {
205 sym = types_heap[params_idx][i]
209 return "!\"Incompatible type for element of argument 1 of 'fn*'. Expects symbol, supplied " types_typename
(sym
) "."
211 if (sym ==
"'&" && i
+ 2 != params_len
) {
214 return "!\"Symbol '&' should be followed by last parameter. Parameter list length is " params_len
", position of symbol '&' is " (i
+ 1) "."
217 f_idx = types_allocate
()
218 types_addref
(types_heap
[f_idx
]["params"] = types_heap
[idx
][1])
219 types_addref
(types_heap
[f_idx
]["body"] = types_heap
[idx
][2])
220 types_heap
[f_idx
]["env"] = env
225 function EVAL
(ast
, env
, new_ast
, ret
, idx
, f
, f_idx
)
229 ret = eval_ast
(ast
, env
)
235 if (types_heap
[idx
]["len"] ==
0) {
239 switch
(types_heap
[idx
][0]) {
241 return EVAL_def
(ast
, env
)
243 return EVAL_let
(ast
, env
)
245 return EVAL_do
(ast
, env
)
247 return EVAL_if
(ast
, env
)
249 return EVAL_fn
(ast
, env
)
251 new_ast = eval_ast
(ast
, env
)
254 if (new_ast ~
/^!
/) {
257 idx =
substr(new_ast
, 2)
258 f = types_heap
[idx
][0]
262 env = env_new
(types_heap
[f_idx
]["env"], types_heap
[f_idx
]["params"], idx
)
264 types_release
(new_ast
)
267 types_addref
(ast = types_heap
[f_idx
]["body"])
268 types_release
(new_ast
)
274 types_release
(new_ast
)
277 types_release
(new_ast
)
278 return "!\"First element of list must be function, supplied " types_typename
(f
) "."
283 function PRINT(expr
, str
)
285 str = printer_pr_str
(expr
, 1)
290 function rep
(str
, ast
, expr
)
296 expr = EVAL
(ast
, repl_env
)
303 function main
(str
, ret
, i
)
307 env_set
(repl_env
, i
, core_ns
[i
])
310 rep
("(def! not (fn* (a) (if a false true)))")
314 if (getline str
<=
0) {
319 print "ERROR: " printer_pr_str
(substr(ret
, 2))