return eval_failure(SYMBOL(gc, "not-implemented"));
}
-static struct EvalResult length(Gc *gc, struct Expr obj)
-{
- if (!list_p(obj)) {
- return wrong_argument_type(gc, "listp", obj);
- }
-
- return eval_success(NUMBER(gc, length_of_list(obj)));
-}
-
static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
{
(void) scope;
return eval_success(atom_as_expr(atom));
case ATOM_SYMBOL: {
- if (nil_p(atom_as_expr(atom))) {
- return eval_success(atom_as_expr(atom));
- }
-
struct Expr value = get_scope_value(scope, atom_as_expr(atom));
if (nil_p(value)) {
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)
-{
- (void) param;
- assert(gc);
- assert(scope);
-
- long int result = 0L;
-
- while (!nil_p(args)) {
- if (!cons_p(args)) {
- return wrong_argument_type(gc, "consp", args);
- }
-
- if (!number_p(CAR(args))) {
- return wrong_argument_type(gc, "numberp", CAR(args));
- }
-
- result += CAR(args).atom->num;
- args = CDR(args);
- }
-
- return eval_success(NUMBER(gc, result));
-}
-
static struct EvalResult call_lambda(Gc *gc,
struct Scope *scope,
struct Expr lambda,
static struct EvalResult call_callable(Gc *gc,
struct Scope *scope,
- struct Expr callable,
- struct Expr args) {
- if (callable.type == EXPR_ATOM && callable.atom->type == ATOM_NATIVE) {
- return ((NativeFunction)callable.atom->native.fun)(callable.atom->native.param, gc, scope, args);
+ struct Expr callable_expr,
+ struct Expr args_expr) {
+ struct EvalResult callable_result = eval(gc, scope, callable_expr);
+ if (callable_result.is_error) {
+ return callable_result;
}
- return call_lambda(gc, scope, callable, args);
-}
+ struct EvalResult args_result = symbol_p(callable_expr) && is_special(callable_expr.atom->sym)
+ ? eval_success(args_expr)
+ : eval_all_args(gc, scope, args_expr);
-static struct Expr
-lambda(Gc *gc, struct Expr args, struct Expr body)
-{
- return CONS(gc,
- SYMBOL(gc, "lambda"),
- CONS(gc, args, body));
+ if (args_result.is_error) {
+ return args_result;
+ }
+
+ if (callable_result.expr.type == EXPR_ATOM &&
+ callable_result.expr.atom->type == ATOM_NATIVE) {
+ return ((NativeFunction)callable_result.expr.atom->native.fun)(
+ callable_result.expr.atom->native.param, gc, scope, args_result.expr);
+ }
+
+ return call_lambda(gc, scope, callable_result.expr, args_result.expr);
}
-static struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
+
+struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
{
assert(gc);
assert(scope);
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, "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);
-}
-
struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
{
switch(expr.type) {
return eval_atom(gc, scope, expr.atom);
case EXPR_CONS:
- return eval_funcall(gc, scope, expr.cons);
+ return call_callable(gc, scope, expr.cons->car, expr.cons->cdr);
default: {}
}
return eval_success(CAR(xs));
}
-/* 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)
-{
- set_scope_value(
- gc,
- 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, ...)
{
}
}
+ if (*format == '*' && nil_p(xs)) {
+ struct Expr *p = va_arg(args_list, struct Expr*);
+ if (p != NULL) {
+ *p = NIL(gc);
+ }
+ format++;
+ }
+
if (*format != 0 || !nil_p(xs)) {
va_end(args_list);
return wrong_number_of_arguments(gc, i);
return eval_success(NIL(gc));
}
-/* TODO(#542): format_list(). Similar to match_list() but for constructing list */
+static struct Expr
+format_list_rec(Gc *gc, const char *format, va_list args)
+{
+ assert(gc);
+ assert(format);
+
+ if (*format == 0) {
+ return NIL(gc);
+ }
+
+ switch (*format) {
+ case 'd': {
+ long int p = va_arg(args, long int);
+ return CONS(gc, NUMBER(gc, p),
+ format_list_rec(gc, format + 1, args));
+ }
+
+ case 's': {
+ const char* p = va_arg(args, const char*);
+ return CONS(gc, STRING(gc, p),
+ format_list_rec(gc, format + 1, args));
+ }
+
+ case 'q': {
+ const char* p = va_arg(args, const char*);
+ return CONS(gc, SYMBOL(gc, p),
+ format_list_rec(gc, format + 1, args));
+ }
+
+ case 'e': {
+ struct Expr p = va_arg(args, struct Expr);
+ return CONS(gc, p, format_list_rec(gc, format + 1, args));
+ }
+
+ default: {
+ fprintf(stderr, "Wrong format parameter: %c\n", *format);
+ assert(0);
+ }
+ }
+}
+
+struct Expr
+format_list(Gc *gc, const char *format, ...)
+{
+ va_list args;
+ va_start(args, format);
+ struct Expr result = format_list_rec(gc, format, args);
+ va_end(args);
+
+ return result;
+}
projects / nothing.git / blobdiff