7 #include "./builtins.h"
9 #include "./interpreter.h"
12 struct EvalResult eval_success(struct Expr expr)
14 struct EvalResult result = {
22 struct EvalResult eval_failure(struct Expr error)
24 struct EvalResult result = {
33 wrong_argument_type(Gc *gc, const char *type, struct Expr obj)
37 SYMBOL(gc, "wrong-argument-type"),
43 wrong_number_of_arguments(Gc *gc, long int count)
47 SYMBOL(gc, "wrong-number-of-arguments"),
52 not_implemented(Gc *gc)
54 return eval_failure(SYMBOL(gc, "not-implemented"));
57 static struct EvalResult length(Gc *gc, struct Expr obj)
60 return wrong_argument_type(gc, "listp", obj);
63 return eval_success(NUMBER(gc, length_of_list(obj)));
66 static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
75 return eval_success(atom_as_expr(atom));
78 struct Expr value = get_scope_value(scope, atom_as_expr(atom));
81 return eval_failure(CONS(gc,
82 SYMBOL(gc, "void-variable"),
86 return eval_success(value.cons->cdr);
90 return eval_failure(CONS(gc,
91 SYMBOL(gc, "unexpected-expression"),
95 static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr args)
102 return eval_atom(gc, scope, args.atom);
105 struct EvalResult car = eval(gc, scope, args.cons->car);
110 struct EvalResult cdr = eval_all_args(gc, scope, args.cons->cdr);
115 return eval_success(cons_as_expr(create_cons(gc, car.expr, cdr.expr)));
121 return eval_failure(CONS(gc,
122 SYMBOL(gc, "unexpected-expression"),
126 static struct EvalResult
127 assoc_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
133 struct Expr key = NIL(gc);
134 struct Expr alist = NIL(gc);
135 struct EvalResult result = match_list(gc, "ee", args, &key, &alist);
136 if (result.is_error) {
140 return eval_success(assoc(key, alist));
143 static struct EvalResult
144 plus_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
150 long int result = 0L;
152 while (!nil_p(args)) {
154 return wrong_argument_type(gc, "consp", args);
157 if (!number_p(CAR(args))) {
158 return wrong_argument_type(gc, "numberp", CAR(args));
161 result += CAR(args).atom->num;
165 return eval_success(NUMBER(gc, result));
168 static struct EvalResult call_lambda(Gc *gc,
172 if (!lambda_p(lambda)) {
173 return eval_failure(CONS(gc,
174 SYMBOL(gc, "expected-callable"),
179 return eval_failure(CONS(gc,
180 SYMBOL(gc, "expected-list"),
184 struct Expr vars = lambda.cons->cdr.cons->car;
186 if (length_of_list(args) != length_of_list(vars)) {
187 return eval_failure(CONS(gc,
188 SYMBOL(gc, "wrong-number-of-arguments"),
189 NUMBER(gc, length_of_list(args))));
192 push_scope_frame(gc, scope, vars, args);
193 struct Expr body = lambda.cons->cdr.cons->cdr;
195 struct EvalResult result = eval_success(NIL(gc));
197 while (!nil_p(body)) {
198 result = eval(gc, scope, body.cons->car);
199 if (result.is_error) {
202 body = body.cons->cdr;
205 pop_scope_frame(gc, scope);
210 static struct EvalResult call_callable(Gc *gc,
212 struct Expr callable_expr,
213 struct Expr args_expr) {
214 struct EvalResult callable_result = eval(gc, scope, callable_expr);
215 if (callable_result.is_error) {
216 return callable_result;
219 struct EvalResult args_result = symbol_p(callable_expr) && is_special(callable_expr.atom->sym)
220 ? eval_success(args_expr)
221 : eval_all_args(gc, scope, args_expr);
223 if (args_result.is_error) {
227 if (callable_result.expr.type == EXPR_ATOM &&
228 callable_result.expr.atom->type == ATOM_NATIVE) {
229 return ((NativeFunction)callable_result.expr.atom->native.fun)(
230 callable_result.expr.atom->native.param, gc, scope, args_result.expr);
233 return call_lambda(gc, scope, callable_result.expr, args_result.expr);
237 lambda(Gc *gc, struct Expr args, struct Expr body)
240 SYMBOL(gc, "lambda"),
241 CONS(gc, args, body));
244 static struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
249 if (!list_p(block)) {
250 return wrong_argument_type(gc, "listp", block);
253 struct Expr head = block;
254 struct EvalResult eval_result = eval_success(NIL(gc));
256 while (cons_p(head)) {
257 eval_result = eval(gc, scope, CAR(head));
258 if (eval_result.is_error) {
268 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
273 if (symbol_p(cons->car)) {
274 /* TODO(#580): eval_funcall contains some special forms that are not native function of stdlib */
275 if (strcmp(cons->car.atom->sym, "set") == 0) {
276 struct Expr args = cons->cdr;
277 struct EvalResult n = length(gc, args);
283 if (n.expr.atom->num != 2) {
284 return eval_failure(list(gc, 3,
285 SYMBOL(gc, "wrong-number-of-arguments"),
287 NUMBER(gc, n.expr.atom->num)));
290 struct Expr name = args.cons->car;
291 if (!symbol_p(name)) {
292 return eval_failure(list(gc, 3,
293 SYMBOL(gc, "wrong-type-argument"),
294 SYMBOL(gc, "symbolp"),
298 struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
299 if (value.is_error) {
303 set_scope_value(gc, scope, name, value.expr);
305 return eval_success(value.expr);
306 } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
307 /* TODO(#334): quote does not check the amout of it's arguments */
308 return eval_success(cons->cdr.cons->car);
309 } else if (strcmp(cons->car.atom->sym, "begin") == 0) {
310 return eval_block(gc, scope, CDR(cons_as_expr(cons)));
311 } else if (is_lambda(cons)) {
312 /* TODO(#335): lambda special form doesn't check if it forms a callable object */
313 return eval_success(cons_as_expr(cons));
314 } else if (strcmp(cons->car.atom->sym, "defun") == 0) {
315 struct Expr name = NIL(gc);
316 struct Expr args = NIL(gc);
317 struct Expr body = NIL(gc);
319 /* TODO(#554): defun doesn't support functions with empty body because of #545 */
320 struct EvalResult result = match_list(gc, "ee*", cons->cdr, &name, &args, &body);
321 if (result.is_error) {
325 return eval(gc, scope,
329 lambda(gc, args, body)));
330 } else if (strcmp(cons->car.atom->sym, "when") == 0) {
331 struct Expr condition = NIL(gc);
332 struct Expr body = NIL(gc);
334 struct EvalResult result = match_list(
335 gc, "e*", cons->cdr, &condition, &body);
336 if (result.is_error) {
340 result = eval(gc, scope, condition);
341 if (result.is_error) {
345 if (!nil_p(result.expr)) {
346 return eval_block(gc, scope, body);
349 return eval_success(NIL(gc));
353 return call_callable(gc, scope, cons->car, cons->cdr);
356 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
360 return eval_atom(gc, scope, expr.atom);
363 return eval_funcall(gc, scope, expr.cons);
368 return eval_failure(CONS(gc,
369 SYMBOL(gc, "unexpected-expression"),
374 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
380 struct Expr xs = NIL(gc);
382 struct EvalResult result = match_list(gc, "e", args, &xs);
383 if (result.is_error) {
388 return eval_success(xs);
392 return wrong_argument_type(gc, "consp", xs);
395 return eval_success(CAR(xs));
398 static struct EvalResult
399 list_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
405 return eval_success(args);
408 /* TODO(#536): greaterThan does not support arbitrary amount of arguments */
409 static struct EvalResult
410 greaterThan(void *param, Gc *gc, struct Scope *scope, struct Expr args)
416 long int x = 0, y = 0;
418 struct EvalResult result = match_list(gc, "dd", args, &x, &y);
419 if (result.is_error) {
424 return eval_success(T(gc));
426 return eval_success(NIL(gc));
430 static struct EvalResult
431 quasiquote(void *param, Gc *gc, struct Scope *scope, struct Expr expr)
438 /* TODO(#582): quasiquote special form is not implemented */
440 return not_implemented(gc);
443 void load_std_library(Gc *gc, struct Scope *scope)
449 NATIVE(gc, car, NULL));
454 NATIVE(gc, greaterThan, NULL));
459 NATIVE(gc, plus_op, NULL));
464 NATIVE(gc, list_op, NULL));
479 NATIVE(gc, assoc_op, NULL));
483 SYMBOL(gc, "quasiquote"),
484 NATIVE(gc, quasiquote, NULL));
488 match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
491 va_start(args_list, xs);
494 for (i = 0; *format != 0 && !nil_p(xs); ++i) {
497 return wrong_argument_type(gc, "consp", xs);
500 struct Expr x = CAR(xs);
506 return wrong_argument_type(gc, "numberp", x);
509 long int *p = va_arg(args_list, long int *);
518 return wrong_argument_type(gc, "stringp", x);
521 const char **p = va_arg(args_list, const char**);
530 return wrong_argument_type(gc, "symbolp", x);
533 const char **p = va_arg(args_list, const char**);
540 struct Expr *p = va_arg(args_list, struct Expr*);
545 struct Expr *p = va_arg(args_list, struct Expr*);
559 if (*format == '*' && nil_p(xs)) {
560 struct Expr *p = va_arg(args_list, struct Expr*);
567 if (*format != 0 || !nil_p(xs)) {
569 return wrong_number_of_arguments(gc, i);
573 return eval_success(NIL(gc));
577 format_list_rec(Gc *gc, const char *format, va_list args)
588 long int p = va_arg(args, long int);
589 return CONS(gc, NUMBER(gc, p),
590 format_list_rec(gc, format + 1, args));
594 const char* p = va_arg(args, const char*);
595 return CONS(gc, STRING(gc, p),
596 format_list_rec(gc, format + 1, args));
600 const char* p = va_arg(args, const char*);
601 return CONS(gc, SYMBOL(gc, p),
602 format_list_rec(gc, format + 1, args));
606 struct Expr p = va_arg(args, struct Expr);
607 return CONS(gc, p, format_list_rec(gc, format + 1, args));
611 fprintf(stderr, "Wrong format parameter: %c\n", *format);
618 format_list(Gc *gc, const char *format, ...)
621 va_start(args, format);
622 struct Expr result = format_list_rec(gc, format, args);