1 #include "system/stacktrace.h"
5 #include "ebisp/interpreter.h"
6 #include "ebisp/builtins.h"
7 #include "ebisp/scope.h"
8 #include "ebisp/parser.h"
13 lambda(Gc *gc, struct Expr args, struct Expr body, struct Scope *scope)
15 return atom_as_expr(create_lambda_atom(gc, args, body, scope->expr));
18 static struct EvalResult
19 quasiquote(void *param, Gc *gc, struct Scope *scope, struct Expr args)
25 struct Expr expr = void_expr();
26 struct EvalResult result = match_list(gc, "e", args, &expr);
27 if (result.is_error) {
31 const char *unquote = NULL;
32 struct Expr unquote_expr = void_expr();
33 result = match_list(gc, "qe", expr, &unquote, &unquote_expr);
35 if (!result.is_error && strcmp(unquote, "unquote") == 0) {
36 return eval(gc, scope, unquote_expr);
37 } else if (cons_p(expr)) {
38 struct EvalResult left = quasiquote(param, gc, scope, CONS(gc, CAR(expr), NIL(gc)));
42 struct EvalResult right = quasiquote(param, gc, scope, CONS(gc, CDR(expr), NIL(gc)));
46 return eval_success(CONS(gc, left.expr, right.expr));
48 return eval_success(expr);
52 static struct EvalResult
53 unquote(void *param, Gc *gc, struct Scope *scope, struct Expr args)
60 return eval_failure(STRING(gc, "Using unquote outside of quasiquote."));
63 static struct EvalResult
64 greaterThan(void *param, Gc *gc, struct Scope *scope, struct Expr args)
71 struct Expr xs = void_expr();
73 struct EvalResult result = match_list(gc, "d*", args, &x1, &xs);
74 if (result.is_error) {
80 while (!nil_p(xs) && sorted) {
82 result = match_list(gc, "d*", xs, &x2, NULL);
83 if (result.is_error) {
87 sorted = sorted && (x1 > x2);
90 result = match_list(gc, "d*", args, &x1, &xs);
91 if (result.is_error) {
96 return eval_success(bool_as_expr(gc, sorted));
99 static struct EvalResult
100 list_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
106 return eval_success(args);
109 static struct EvalResult
110 plus_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
116 long int result = 0L;
118 while (!nil_p(args)) {
120 return wrong_argument_type(gc, "consp", args);
123 if (!number_p(CAR(args))) {
124 return wrong_argument_type(gc, "numberp", CAR(args));
127 result += CAR(args).atom->num;
131 return eval_success(NUMBER(gc, result));
134 static struct EvalResult
135 mul_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
141 long int result = 1L;
143 while (!nil_p(args)) {
145 return wrong_argument_type(gc, "consp", args);
148 if (!number_p(CAR(args))) {
149 return wrong_argument_type(gc, "numberp", CAR(args));
152 result *= CAR(args).atom->num;
156 return eval_success(NUMBER(gc, result));
159 static struct EvalResult
160 assoc_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
166 struct Expr key = NIL(gc);
167 struct Expr alist = NIL(gc);
168 struct EvalResult result = match_list(gc, "ee", args, &key, &alist);
169 if (result.is_error) {
173 return eval_success(assoc(key, alist));
176 static struct EvalResult
177 set(void *param, Gc *gc, struct Scope *scope, struct Expr args)
183 const char *name = NULL;
184 struct Expr value = void_expr();
185 struct EvalResult result = match_list(gc, "qe", args, &name, &value);
186 if (result.is_error) {
190 result = eval(gc, scope, value);
191 if (result.is_error) {
195 set_scope_value(gc, scope, SYMBOL(gc, name), result.expr);
197 return eval_success(result.expr);
200 static struct EvalResult
201 quote(void *param, Gc *gc, struct Scope *scope, struct Expr args)
207 struct Expr expr = void_expr();
208 struct EvalResult result = match_list(gc, "e", args, &expr);
209 if (result.is_error) {
213 return eval_success(expr);
216 static struct EvalResult
217 begin(void *param, Gc *gc, struct Scope *scope, struct Expr args)
223 struct Expr block = void_expr();
224 struct EvalResult result = match_list(gc, "*", args, &block);
225 if (result.is_error) {
229 return eval_block(gc, scope, block);
232 static struct EvalResult
233 defun(void *param, Gc *gc, struct Scope *scope, struct Expr args)
239 struct Expr name = void_expr();
240 struct Expr args_list = void_expr();
241 struct Expr body = void_expr();
243 struct EvalResult result = match_list(gc, "ee*", args, &name, &args_list, &body);
244 if (result.is_error) {
248 if (!list_of_symbols_p(args_list)) {
249 return wrong_argument_type(gc, "list-of-symbolsp", args_list);
252 return eval(gc, scope,
253 list(gc, "qee", "set", name,
254 lambda(gc, args_list, body, scope)));
257 static struct EvalResult
258 when(void *param, Gc *gc, struct Scope *scope, struct Expr args)
264 struct Expr condition = void_expr();
265 struct Expr body = void_expr();
267 struct EvalResult result = match_list(
268 gc, "e*", args, &condition, &body);
269 if (result.is_error) {
273 result = eval(gc, scope, condition);
274 if (result.is_error) {
278 if (!nil_p(result.expr)) {
279 return eval_block(gc, scope, body);
282 return eval_success(NIL(gc));
285 static struct EvalResult
286 lambda_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
292 struct Expr args_list = void_expr();
293 struct Expr body = void_expr();
295 struct EvalResult result = match_list(gc, "e*", args, &args_list, &body);
296 if (result.is_error) {
300 if (!list_of_symbols_p(args_list)) {
301 return wrong_argument_type(gc, "list-of-symbolsp", args_list);
304 return eval_success(lambda(gc, args_list, body, scope));
307 static struct EvalResult
308 equal_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
316 struct EvalResult result = match_list(gc, "ee", args, &obj1, &obj2);
317 if (result.is_error) {
321 if (equal(obj1, obj2)) {
322 return eval_success(T(gc));
324 return eval_success(NIL(gc));
328 static struct EvalResult
329 load(void *param, Gc *gc, struct Scope *scope, struct Expr args)
335 const char *filename = NULL;
336 struct EvalResult result = match_list(gc, "s", args, &filename);
337 if (result.is_error) {
341 struct ParseResult parse_result = read_all_exprs_from_file(gc, filename);
342 if (parse_result.is_error) {
343 /* TODO(#599): (load) does not provide position of the parse error */
344 return read_error(gc, parse_result.error_message, 0);
347 return eval_block(gc, scope, parse_result.expr);
350 // TODO(#672): append does not work with arbitrary amount of arguments
351 // TODO(#673): append is implemented recursively
352 // It's very StackOverflow prone
353 static struct EvalResult
354 append(void *param, Gc *gc, struct Scope *scope, struct Expr args)
360 struct Expr xs = void_expr();
361 struct Expr ys = void_expr();
362 struct EvalResult result = match_list(gc, "ee", args, &xs, &ys);
363 if (result.is_error) {
368 return eval_success(ys);
371 struct Expr xs1 = void_expr();
372 struct Expr x = void_expr();
373 result = match_list(gc, "e*", xs, &x, &xs1);
374 if (result.is_error) {
378 result = append(param, gc, scope, list(gc, "ee", xs1, ys));
379 if (result.is_error) {
383 return eval_success(CONS(gc, x, result.expr));
386 void load_std_library(Gc *gc, struct Scope *scope)
388 set_scope_value(gc, scope, SYMBOL(gc, "car"), NATIVE(gc, car, NULL));
389 set_scope_value(gc, scope, SYMBOL(gc, ">"), NATIVE(gc, greaterThan, NULL));
390 set_scope_value(gc, scope, SYMBOL(gc, "+"), NATIVE(gc, plus_op, NULL));
391 set_scope_value(gc, scope, SYMBOL(gc, "*"), NATIVE(gc, mul_op, NULL));
392 set_scope_value(gc, scope, SYMBOL(gc, "list"), NATIVE(gc, list_op, NULL));
393 set_scope_value(gc, scope, SYMBOL(gc, "t"), SYMBOL(gc, "t"));
394 set_scope_value(gc, scope, SYMBOL(gc, "nil"), SYMBOL(gc, "nil"));
395 set_scope_value(gc, scope, SYMBOL(gc, "assoc"), NATIVE(gc, assoc_op, NULL));
396 set_scope_value(gc, scope, SYMBOL(gc, "quasiquote"), NATIVE(gc, quasiquote, NULL));
397 set_scope_value(gc, scope, SYMBOL(gc, "set"), NATIVE(gc, set, NULL));
398 set_scope_value(gc, scope, SYMBOL(gc, "quote"), NATIVE(gc, quote, NULL));
399 set_scope_value(gc, scope, SYMBOL(gc, "begin"), NATIVE(gc, begin, NULL));
400 set_scope_value(gc, scope, SYMBOL(gc, "defun"), NATIVE(gc, defun, NULL));
401 set_scope_value(gc, scope, SYMBOL(gc, "when"), NATIVE(gc, when, NULL));
402 set_scope_value(gc, scope, SYMBOL(gc, "lambda"), NATIVE(gc, lambda_op, NULL));
403 set_scope_value(gc, scope, SYMBOL(gc, "λ"), NATIVE(gc, lambda_op, NULL));
404 set_scope_value(gc, scope, SYMBOL(gc, "unquote"), NATIVE(gc, unquote, NULL));
405 set_scope_value(gc, scope, SYMBOL(gc, "load"), NATIVE(gc, load, NULL));
406 set_scope_value(gc, scope, SYMBOL(gc, "append"), NATIVE(gc, append, NULL));
407 set_scope_value(gc, scope, SYMBOL(gc, "equal"), NATIVE(gc, equal_op, NULL));