6 #include "./builtins.h"
8 #include "./interpreter.h"
11 struct EvalResult eval_success(struct Expr expr)
13 struct EvalResult result = {
21 struct EvalResult eval_failure(struct Expr error)
23 struct EvalResult result = {
32 wrong_argument_type(Gc *gc, const char *type, struct Expr obj)
36 SYMBOL(gc, "wrong-argument-type"),
42 wrong_number_of_arguments(Gc *gc, long int count)
46 SYMBOL(gc, "wrong-number-of-arguments"),
51 not_implemented(Gc *gc)
53 return eval_failure(SYMBOL(gc, "not-implemented"));
56 static struct EvalResult length(Gc *gc, struct Expr obj)
59 return wrong_argument_type(gc, "listp", obj);
62 return eval_success(NUMBER(gc, length_of_list(obj)));
65 static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
74 return eval_success(atom_as_expr(atom));
77 if (nil_p(atom_as_expr(atom))) {
78 return eval_success(atom_as_expr(atom));
81 struct Expr value = get_scope_value(scope, atom_as_expr(atom));
84 return eval_failure(CONS(gc,
85 SYMBOL(gc, "void-variable"),
89 return eval_success(value.cons->cdr);
93 return eval_failure(CONS(gc,
94 SYMBOL(gc, "unexpected-expression"),
98 static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr args)
105 return eval_atom(gc, scope, args.atom);
108 struct EvalResult car = eval(gc, scope, args.cons->car);
113 struct EvalResult cdr = eval_all_args(gc, scope, args.cons->cdr);
118 return eval_success(cons_as_expr(create_cons(gc, car.expr, cdr.expr)));
124 return eval_failure(CONS(gc,
125 SYMBOL(gc, "unexpected-expression"),
129 static struct EvalResult plus_op(Gc *gc, struct Expr args)
131 long int result = 0.0f;
133 while (!nil_p(args)) {
134 if (args.type != EXPR_CONS) {
135 return eval_failure(CONS(gc,
136 SYMBOL(gc, "expected-cons"),
140 if (args.cons->car.type != EXPR_ATOM ||
141 args.cons->car.atom->type != ATOM_NUMBER) {
142 return eval_failure(CONS(gc,
143 SYMBOL(gc, "expected-number"),
147 result += args.cons->car.atom->num;
148 args = args.cons->cdr;
151 return eval_success(atom_as_expr(create_number_atom(gc, result)));
154 static struct EvalResult call_lambda(Gc *gc,
158 if (!lambda_p(lambda)) {
159 return eval_failure(CONS(gc,
160 SYMBOL(gc, "expected-callable"),
165 return eval_failure(CONS(gc,
166 SYMBOL(gc, "expected-list"),
170 struct Expr vars = lambda.cons->cdr.cons->car;
172 if (length_of_list(args) != length_of_list(vars)) {
173 return eval_failure(CONS(gc,
174 SYMBOL(gc, "wrong-number-of-arguments"),
175 NUMBER(gc, length_of_list(args))));
178 push_scope_frame(gc, scope, vars, args);
179 struct Expr body = lambda.cons->cdr.cons->cdr;
181 struct EvalResult result = eval_success(NIL(gc));
183 while (!nil_p(body)) {
184 result = eval(gc, scope, body.cons->car);
185 if (result.is_error) {
188 body = body.cons->cdr;
191 pop_scope_frame(gc, scope);
196 static struct EvalResult call_callable(Gc *gc,
198 struct Expr callable,
200 if (callable.type == EXPR_ATOM && callable.atom->type == ATOM_NATIVE) {
201 return ((NativeFunction)callable.atom->native.fun)(callable.atom->native.param, gc, scope, args);
204 return call_lambda(gc, scope, callable, args);
207 static struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
212 if (!list_p(block)) {
213 return wrong_argument_type(gc, "listp", block);
216 struct Expr head = block;
217 struct EvalResult eval_result = eval_success(NIL(gc));
219 while (cons_p(head)) {
220 eval_result = eval(gc, scope, CAR(head));
221 if (eval_result.is_error) {
231 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
236 if (symbol_p(cons->car)) {
237 if (strcmp(cons->car.atom->sym, "+") == 0) {
238 struct EvalResult args = eval_all_args(gc, scope, cons->cdr);
242 return plus_op(gc, args.expr);
243 } else if (strcmp(cons->car.atom->sym, "set") == 0) {
244 struct Expr args = cons->cdr;
245 struct EvalResult n = length(gc, args);
251 if (n.expr.atom->num != 2) {
252 return eval_failure(list(gc, 3,
253 SYMBOL(gc, "wrong-number-of-arguments"),
255 NUMBER(gc, n.expr.atom->num)));
258 struct Expr name = args.cons->car;
259 if (!symbol_p(name)) {
260 return eval_failure(list(gc, 3,
261 SYMBOL(gc, "wrong-type-argument"),
262 SYMBOL(gc, "symbolp"),
266 struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
267 if (value.is_error) {
271 set_scope_value(gc, scope, name, value.expr);
273 return eval_success(value.expr);
274 } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
275 /* TODO(#334): quote does not check the amout of it's arguments */
276 return eval_success(cons->cdr.cons->car);
277 } else if (strcmp(cons->car.atom->sym, "begin") == 0) {
278 return eval_block(gc, scope, CDR(cons_as_expr(cons)));
279 } else if (strcmp(cons->car.atom->sym, "lambda") == 0) {
280 /* TODO(#335): lambda special form doesn't check if it forms a callable object */
281 return eval_success(cons_as_expr(cons));
282 } else if (strcmp(cons->car.atom->sym, "when") == 0) {
283 struct Expr condition = NIL(gc);
284 struct Expr body = NIL(gc);
286 struct EvalResult result = unpack_args(
287 gc, "e*", cons->cdr, &condition, &body);
288 if (result.is_error) {
292 result = eval(gc, scope, condition);
293 if (result.is_error) {
297 if (!nil_p(result.expr)) {
298 return eval_block(gc, scope, body);
301 return eval_success(NIL(gc));
305 struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
311 return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
314 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
318 return eval_atom(gc, scope, expr.atom);
321 return eval_funcall(gc, scope, expr.cons);
326 return eval_failure(CONS(gc,
327 SYMBOL(gc, "unexpected-expression"),
332 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
339 return wrong_argument_type(gc, "listp", args);
342 if (length_of_list(args) != 1) {
343 return wrong_number_of_arguments(gc, length_of_list(args));
346 struct Expr xs = args.cons->car;
349 return eval_success(xs);
352 return eval_success(xs.cons->car);
355 void load_std_library(Gc *gc, struct Scope *scope)
361 NATIVE(gc, car, NULL));
364 /* TODO(#530): unpack_args doesn't support * format parameter */
366 unpack_args(struct Gc *gc, const char *format, struct Expr args, ...)
369 va_start(args_list, args);
373 return wrong_argument_type(gc, "listp", args);
377 for (i = 0; *format != 0 && !nil_p(args); ++i) {
378 struct Expr arg = CAR(args);
382 if (!number_p(arg)) {
384 return wrong_argument_type(gc, "numberp", arg);
387 long int *p = va_arg(args_list, long int *);
392 if (!string_p(arg)) {
394 return wrong_argument_type(gc, "stringp", arg);
397 const char **p = va_arg(args_list, const char**);
402 if (!symbol_p(arg)) {
404 return wrong_argument_type(gc, "symbolp", arg);
407 const char **p = va_arg(args_list, const char**);
412 struct Expr *p = va_arg(args_list, struct Expr*);
417 struct Expr *p = va_arg(args_list, struct Expr*);
429 if (*format != 0 || !nil_p(args)) {
432 SYMBOL(gc, "wrong-number-of-arguments"),
436 return eval_success(NIL(gc));