#include <assert.h>
#include <math.h>
#include <string.h>
+#include <stdarg.h>
#include "./builtins.h"
#include "./expr.h"
NUMBER(gc, count)));
}
+struct EvalResult
+not_implemented(Gc *gc)
+{
+ return eval_failure(SYMBOL(gc, "not-implemented"));
+}
+
static struct EvalResult length(Gc *gc, struct Expr obj)
{
if (!list_p(obj)) {
args));
}
-static struct EvalResult plus_op(Gc *gc, struct Expr args)
+/* TODO(#540): plus_op should be part of std library */
+static struct EvalResult
+plus_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
{
- long int result = 0.0f;
+ (void) param;
+ assert(gc);
+ assert(scope);
+
+ long int result = 0L;
while (!nil_p(args)) {
- if (args.type != EXPR_CONS) {
- return eval_failure(CONS(gc,
- SYMBOL(gc, "expected-cons"),
- args));
+ if (!cons_p(args)) {
+ return wrong_argument_type(gc, "consp", args);
}
- if (args.cons->car.type != EXPR_ATOM ||
- args.cons->car.atom->type != ATOM_NUMBER) {
- return eval_failure(CONS(gc,
- SYMBOL(gc, "expected-number"),
- args.cons->car));
+ if (!number_p(CAR(args))) {
+ return wrong_argument_type(gc, "numberp", CAR(args));
}
- result += args.cons->car.atom->num;
- args = args.cons->cdr;
+ result += CAR(args).atom->num;
+ args = CDR(args);
}
- return eval_success(atom_as_expr(create_number_atom(gc, result)));
+ return eval_success(NUMBER(gc, result));
}
static struct EvalResult call_lambda(Gc *gc,
return call_lambda(gc, scope, callable, args);
}
+static struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
+{
+ assert(gc);
+ assert(scope);
+
+ if (!list_p(block)) {
+ return wrong_argument_type(gc, "listp", block);
+ }
+
+ struct Expr head = block;
+ struct EvalResult eval_result = eval_success(NIL(gc));
+
+ while (cons_p(head)) {
+ eval_result = eval(gc, scope, CAR(head));
+ if (eval_result.is_error) {
+ return eval_result;
+ }
+
+ head = CDR(head);
+ }
+
+ return eval_result;
+}
+
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, "+") == 0) {
- struct EvalResult args = eval_all_args(gc, scope, cons->cdr);
- if (args.is_error) {
- return args;
- }
- return plus_op(gc, args.expr);
- } else if (strcmp(cons->car.atom->sym, "set") == 0) {
+ if (strcmp(cons->car.atom->sym, "set") == 0) {
struct Expr args = cons->cdr;
struct EvalResult n = length(gc, args);
/* 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) {
- struct Expr head = CDR(cons_as_expr(cons));
-
- struct EvalResult eval_result = eval_success(NIL(gc));
+ return eval_block(gc, scope, CDR(cons_as_expr(cons)));
+ } else if (strcmp(cons->car.atom->sym, "lambda") == 0) {
+ /* 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, "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;
+ }
- while (cons_p(head)) {
- eval_result = eval(gc, scope, CAR(head));
- if (eval_result.is_error) {
- return eval_result;
- }
+ result = eval(gc, scope, condition);
+ if (result.is_error) {
+ return result;
+ }
- head = CDR(head);
+ if (!nil_p(result.expr)) {
+ return eval_block(gc, scope, body);
}
- return eval_result;
- } else if (strcmp(cons->car.atom->sym, "lambda") == 0) {
- /* TODO(#335): lambda special form doesn't check if it forms a callable object */
- return eval_success(cons_as_expr(cons));
+ return eval_success(NIL(gc));
}
}
assert(gc);
assert(scope);
- if (!list_p(args)) {
- return wrong_argument_type(gc, "listp", args);
- }
+ struct Expr xs = NIL(gc);
+ struct Expr x = NIL(gc);
- if (length_of_list(args) != 1) {
- return wrong_number_of_arguments(gc, length_of_list(args));
+ struct EvalResult result = match_list(gc, "e", args, &xs);
+ if (result.is_error) {
+ return result;
}
- struct Expr xs = args.cons->car;
-
if (nil_p(xs)) {
return eval_success(xs);
}
- return eval_success(xs.cons->car);
+ result = match_list(gc, "e*", xs, &x, NULL);
+ if (result.is_error) {
+ return result;
+ }
+
+ return eval_success(x);
+}
+
+/* TODO(#536): greaterThan does not support arbitrary amount of arguments */
+static struct EvalResult
+greaterThan(void *param, Gc *gc, struct Scope *scope, struct Expr args)
+{
+ assert(gc);
+ assert(scope);
+ (void) param;
+
+ long int x = 0, y = 0;
+
+ struct EvalResult result = match_list(gc, "dd", args, &x, &y);
+ if (result.is_error) {
+ return result;
+ }
+
+ if (x > y) {
+ /* TODO(#537): in ebisp t is not a special symbol that evaluates to itself */
+ return eval_success(SYMBOL(gc, "t"));
+ } else {
+ return eval_success(NIL(gc));
+ }
}
void load_std_library(Gc *gc, struct Scope *scope)
scope,
SYMBOL(gc, "car"),
NATIVE(gc, car, NULL));
+ set_scope_value(
+ gc,
+ scope,
+ SYMBOL(gc, ">"),
+ NATIVE(gc, greaterThan, NULL));
+ set_scope_value(
+ gc,
+ scope,
+ SYMBOL(gc, "+"),
+ NATIVE(gc, plus_op, NULL));
}
+
+struct EvalResult
+match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
+{
+ va_list args_list;
+ va_start(args_list, xs);
+
+ /* TODO(#544): match_list is O(N) even in best case (format == "*") */
+ if (!list_p(xs)) {
+ va_end(args_list);
+ return wrong_argument_type(gc, "listp", xs);
+ }
+
+ long int i = 0;
+ for (i = 0; *format != 0 && !nil_p(xs); ++i) {
+ struct Expr x = CAR(xs);
+
+ switch (*format) {
+ case 'd': {
+ if (!number_p(x)) {
+ va_end(args_list);
+ return wrong_argument_type(gc, "numberp", x);
+ }
+
+ long int *p = va_arg(args_list, long int *);
+ if (p != NULL) {
+ *p = x.atom->num;
+ }
+ } break;
+
+ case 's': {
+ if (!string_p(x)) {
+ va_end(args_list);
+ return wrong_argument_type(gc, "stringp", x);
+ }
+
+ const char **p = va_arg(args_list, const char**);
+ if (p != NULL) {
+ *p = x.atom->str;
+ }
+ } break;
+
+ case 'q': {
+ if (!symbol_p(x)) {
+ va_end(args_list);
+ return wrong_argument_type(gc, "symbolp", x);
+ }
+
+ const char **p = va_arg(args_list, const char**);
+ if (p != NULL) {
+ *p = x.atom->sym;
+ }
+ } break;
+
+ case 'e': {
+ struct Expr *p = va_arg(args_list, struct Expr*);
+ *p = x;
+ } break;
+
+ case '*': {
+ struct Expr *p = va_arg(args_list, struct Expr*);
+ if (p != NULL) {
+ *p = xs;
+ }
+ xs = NIL(gc);
+ } break;
+ }
+
+ format++;
+ if (!nil_p(xs)) {
+ xs = CDR(xs);
+ }
+ }
+
+ if (*format != 0 || !nil_p(xs)) {
+ return wrong_number_of_arguments(gc, i);
+ }
+
+ return eval_success(NIL(gc));
+}
+
+/* TODO(#542): format_list(). Similar to match_list() but for constructing list */
projects / nothing.git / blobdiff