X-Git-Url: https://git.lizzy.rs/?a=blobdiff_plain;f=src%2Febisp%2Finterpreter.c;h=4f63e432170ba6d82de6a7186ddad5e25147b82a;hb=8f7179a00fb7d7240ed0c01c97265b8bf00b7f41;hp=d36cc52b2c646ba2edd9b40289b3f125171624a9;hpb=4731efeab3f1284aac3f283d1a182c7daf7796d7;p=nothing.git

diff --git a/src/ebisp/interpreter.c b/src/ebisp/interpreter.c
index d36cc52b..4f63e432 100644
--- a/src/ebisp/interpreter.c
+++ b/src/ebisp/interpreter.c
@@ -1,6 +1,8 @@
-#include <assert.h>
+#include "system/stacktrace.h"
 #include <math.h>
 #include <string.h>
+#include <stdarg.h>
+#include <stdbool.h>
 
 #include "./builtins.h"
 #include "./expr.h"
@@ -31,10 +33,7 @@ struct EvalResult
 wrong_argument_type(Gc *gc, const char *type, struct Expr obj)
 {
     return eval_failure(
-        list(gc, 3,
-             SYMBOL(gc, "wrong-argument-type"),
-             SYMBOL(gc, type),
-             obj));
+        list(gc, "qqe", "wrong-argument-type", type, obj));
 }
 
 struct EvalResult
@@ -46,13 +45,17 @@ wrong_number_of_arguments(Gc *gc, long int count)
              NUMBER(gc, count)));
 }
 
-static struct EvalResult length(Gc *gc, struct Expr obj)
+struct EvalResult
+not_implemented(Gc *gc)
 {
-    if (!list_p(obj)) {
-        return wrong_argument_type(gc, "listp", obj);
-    }
+    return eval_failure(SYMBOL(gc, "not-implemented"));
+}
 
-    return eval_success(NUMBER(gc, length_of_list(obj)));
+struct EvalResult
+read_error(Gc *gc, const char *error_message, long int character)
+{
+    return eval_failure(
+        list(gc, "qsd", "read-error", error_message, character));
 }
 
 static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
@@ -63,14 +66,11 @@ static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *ato
     switch (atom->type) {
     case ATOM_NUMBER:
     case ATOM_STRING:
+    case ATOM_LAMBDA:
     case ATOM_NATIVE:
         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)) {
@@ -119,33 +119,7 @@ static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr
                              args));
 }
 
-static struct EvalResult plus_op(Gc *gc, struct Expr args)
-{
-    long int result = 0.0f;
-
-    while (!nil_p(args)) {
-        if (args.type != EXPR_CONS) {
-            return eval_failure(CONS(gc,
-                                     SYMBOL(gc, "expected-cons"),
-                                     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));
-        }
-
-        result += args.cons->car.atom->num;
-        args = args.cons->cdr;
-    }
-
-    return eval_success(atom_as_expr(create_number_atom(gc, result)));
-}
-
 static struct EvalResult call_lambda(Gc *gc,
-                                     struct Scope *scope,
                                      struct Expr lambda,
                                      struct Expr args) {
     if (!lambda_p(lambda)) {
@@ -160,7 +134,7 @@ static struct EvalResult call_lambda(Gc *gc,
                                  args));
     }
 
-    struct Expr vars = lambda.cons->cdr.cons->car;
+    struct Expr vars = lambda.atom->lambda.args_list;
 
     if (length_of_list(args) != length_of_list(vars)) {
         return eval_failure(CONS(gc,
@@ -168,109 +142,75 @@ static struct EvalResult call_lambda(Gc *gc,
                                  NUMBER(gc, length_of_list(args))));
     }
 
-    push_scope_frame(gc, scope, vars, args);
-    struct Expr body = lambda.cons->cdr.cons->cdr;
+    struct Scope scope = {
+        .expr = lambda.atom->lambda.envir
+    };
+    push_scope_frame(gc, &scope, vars, args);
+
+    struct Expr body = lambda.atom->lambda.body;
 
     struct EvalResult result = eval_success(NIL(gc));
 
     while (!nil_p(body)) {
-        result = eval(gc, scope, body.cons->car);
+        result = eval(gc, &scope, body.cons->car);
         if (result.is_error) {
             return result;
         }
         body = body.cons->cdr;
     }
 
-    pop_scope_frame(gc, scope);
-
     return result;
 }
 
-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);
+static struct EvalResult eval_funcall(Gc *gc,
+                                      struct Scope *scope,
+                                      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);
-}
-
-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) {
-            struct Expr args = cons->cdr;
-            struct EvalResult n = length(gc, 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);
 
-            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));
-            }
+    if (args_result.is_error) {
+        return args_result;
+    }
 
-            struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
-            if (value.is_error) {
-                return value;
-            }
+    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);
+    }
 
-            set_scope_value(gc, scope, name, value.expr);
+    return call_lambda(gc, callable_result.expr, args_result.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) {
-            struct Expr head = CDR(cons_as_expr(cons));
 
-            struct EvalResult eval_result = eval_success(NIL(gc));
+struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
+{
+    trace_assert(gc);
+    trace_assert(scope);
 
-            while (cons_p(head)) {
-                eval_result = eval(gc, scope, CAR(head));
-                if (eval_result.is_error) {
-                    return eval_result;
-                }
+    if (!list_p(block)) {
+        return wrong_argument_type(gc, "listp", block);
+    }
 
-                head = CDR(head);
-            }
+    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;
-        } 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));
         }
-    }
-
-    struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
 
-    if (r.is_error) {
-        return r;
+        head = CDR(head);
     }
 
-    return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
+    return eval_result;
 }
 
 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
@@ -280,7 +220,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 eval_funcall(gc, scope, expr.cons->car, expr.cons->cdr);
 
     default: {}
     }
@@ -294,31 +234,112 @@ struct EvalResult
 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
-    if (!list_p(args)) {
-        return wrong_argument_type(gc, "listp", args);
-    }
+    struct Expr xs = 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);
+    if (!cons_p(xs)) {
+        return wrong_argument_type(gc, "consp", xs);
+    }
+
+    return eval_success(CAR(xs));
 }
 
-void load_std_library(Gc *gc, struct Scope *scope)
+struct EvalResult
+match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
 {
-    set_scope_value(
-        gc,
-        scope,
-        SYMBOL(gc, "car"),
-        NATIVE(gc, car, NULL));
+    va_list args_list;
+    va_start(args_list, xs);
+
+    long int i = 0;
+    for (i = 0; *format != 0 && !nil_p(xs); ++i) {
+        if (!cons_p(xs)) {
+            va_end(args_list);
+            return wrong_argument_type(gc, "consp", xs);
+        }
+
+        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 == '*' && 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);
+    }
+
+    va_end(args_list);
+    return eval_success(NIL(gc));
 }