-static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
-{
- assert(cons);
- (void) scope;
-
- if (symbol_p(cons->car)) {
- if (strcmp(cons->car.atom->sym, "set") == 0) {
- struct Expr args = cons->cdr;
- struct EvalResult n = length(gc, args);
-
- if (n.is_error) {
- return n;
- }
-
- if (n.expr.atom->num != 2) {
- return eval_failure(list(gc, 3,
- SYMBOL(gc, "wrong-number-of-arguments"),
- SYMBOL(gc, "set"),
- NUMBER(gc, n.expr.atom->num)));
- }
-
- struct Expr name = args.cons->car;
- if (!symbol_p(name)) {
- return eval_failure(list(gc, 3,
- SYMBOL(gc, "wrong-type-argument"),
- SYMBOL(gc, "symbolp"),
- name));
- }
-
- struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
- if (value.is_error) {
- return value;
- }
-
- set_scope_value(gc, scope, name, value.expr);
-
- return eval_success(value.expr);
- } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
- /* TODO(#334): quote does not check the amout of it's arguments */
- return eval_success(cons->cdr.cons->car);
- } else if (strcmp(cons->car.atom->sym, "begin") == 0) {
- return eval_block(gc, scope, CDR(cons_as_expr(cons)));
- } else if (is_lambda(cons)) {
- /* TODO(#335): lambda special form doesn't check if it forms a callable object */
- return eval_success(cons_as_expr(cons));
- } else if (strcmp(cons->car.atom->sym, "defun") == 0) {
- struct Expr name = NIL(gc);
- struct Expr args = NIL(gc);
- struct Expr body = NIL(gc);
-
- /* TODO(#554): defun doesn't support functions with empty body because of #545 */
- struct EvalResult result = match_list(gc, "ee*", cons->cdr, &name, &args, &body);
- if (result.is_error) {
- return result;
- }
-
- return eval(gc, scope,
- list(gc, 3,
- SYMBOL(gc, "set"),
- name,
- lambda(gc, args, body)));
- } else if (strcmp(cons->car.atom->sym, "when") == 0) {
- struct Expr condition = NIL(gc);
- struct Expr body = NIL(gc);
-
- struct EvalResult result = match_list(
- gc, "e*", cons->cdr, &condition, &body);
- if (result.is_error) {
- return result;
- }
-
- result = eval(gc, scope, condition);
- if (result.is_error) {
- return result;
- }
-
- if (!nil_p(result.expr)) {
- return eval_block(gc, scope, body);
- }
-
- return eval_success(NIL(gc));
- }
- }
-
- struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
-
- if (r.is_error) {
- return r;
- }
-
- return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
-}
-