X-Git-Url: https://git.lizzy.rs/?a=blobdiff_plain;f=src%2Febisp%2Finterpreter.c;h=6239359a6b68f3c6d57443efefc7c68640849ed9;hb=198bebd6527beaed3b3c41167a3c14cacd1761f2;hp=d44234f51851df0523aa2676491dce48423afb84;hpb=83cde4cf2918f9ba94a746447c86263a9060de99;p=nothing.git diff --git a/src/ebisp/interpreter.c b/src/ebisp/interpreter.c index d44234f5..6239359a 100644 --- a/src/ebisp/interpreter.c +++ b/src/ebisp/interpreter.c @@ -54,15 +54,6 @@ not_implemented(Gc *gc) 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; @@ -75,10 +66,6 @@ static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *ato 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)) { @@ -127,32 +114,6 @@ static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, 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) -{ - (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, @@ -197,24 +158,32 @@ static struct EvalResult call_lambda(Gc *gc, 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); @@ -238,99 +207,6 @@ static struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr blo 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) { @@ -338,7 +214,7 @@ struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr) 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: {} } @@ -373,48 +249,6 @@ car(void *param, Gc *gc, struct Scope *scope, struct Expr args) 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, ...) { @@ -487,6 +321,14 @@ 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); @@ -496,4 +338,54 @@ match_list(struct Gc *gc, const char *format, struct Expr xs, ...) 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; +}