X-Git-Url: https://git.lizzy.rs/?a=blobdiff_plain;f=src%2Febisp%2Fstd.c;h=a6c8beb156ab47360295c7d68acd7360cd6e427e;hb=afd02c09b03542c07301c1ad621856628abcf6c9;hp=ca3a2b925893adec99f89b975f3fc24cfc4e867f;hpb=46ed05bf88d955faea3e9f6dc275f98f044befbb;p=nothing.git

diff --git a/src/ebisp/std.c b/src/ebisp/std.c
index ca3a2b92..a6c8beb1 100644
--- a/src/ebisp/std.c
+++ b/src/ebisp/std.c
@@ -1,60 +1,106 @@
-#include <assert.h>
+#include "system/stacktrace.h"
+#include <string.h>
 
 #include "ebisp/gc.h"
 #include "ebisp/interpreter.h"
 #include "ebisp/builtins.h"
 #include "ebisp/scope.h"
+#include "ebisp/parser.h"
 
 #include "std.h"
 
 static struct Expr
-lambda(Gc *gc, struct Expr args, struct Expr body)
+lambda(Gc *gc, struct Expr args, struct Expr body, struct Scope *scope)
 {
-    return CONS(gc,
-                SYMBOL(gc, "lambda"),
-                CONS(gc, args, body));
+    return atom_as_expr(create_lambda_atom(gc, args, body, scope->expr));
 }
 
 static struct EvalResult
-quasiquote(void *param, Gc *gc, struct Scope *scope, struct Expr expr)
+quasiquote(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
-    (void) expr;
+    trace_assert(gc);
+    trace_assert(scope);
 
-    /* TODO(#582): quasiquote special form is not implemented */
+    struct Expr expr = void_expr();
+    struct EvalResult result = match_list(gc, "e", args, &expr);
+    if (result.is_error) {
+        return result;
+    }
+
+    const char *unquote = NULL;
+    struct Expr unquote_expr = void_expr();
+    result = match_list(gc, "qe", expr, &unquote, &unquote_expr);
+
+    if (!result.is_error && strcmp(unquote, "unquote") == 0) {
+        return eval(gc, scope, unquote_expr);
+    } else if (cons_p(expr)) {
+        struct EvalResult left = quasiquote(param, gc, scope, CONS(gc, CAR(expr), NIL(gc)));
+        if (left.is_error) {
+            return left;
+        }
+        struct EvalResult right = quasiquote(param, gc, scope, CONS(gc, CDR(expr), NIL(gc)));
+        if (right.is_error) {
+            return right;
+        }
+        return eval_success(CONS(gc, left.expr, right.expr));
+    } else {
+        return eval_success(expr);
+    }
+}
+
+static struct EvalResult
+unquote(void *param, Gc *gc, struct Scope *scope, struct Expr args)
+{
+    (void) param;
+    trace_assert(gc);
+    trace_assert(scope);
+    (void) args;
 
-    return not_implemented(gc);
+    return eval_failure(STRING(gc, "Using unquote outside of quasiquote."));
 }
 
-/* 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);
+    trace_assert(gc);
+    trace_assert(scope);
     (void) param;
 
-    long int x = 0, y = 0;
+    long int x1 = 0;
+    struct Expr xs = void_expr();
 
-    struct EvalResult result = match_list(gc, "dd", args, &x, &y);
+    struct EvalResult result = match_list(gc, "d*", args, &x1, &xs);
     if (result.is_error) {
         return result;
     }
 
-    if (x > y) {
-        return eval_success(T(gc));
-    } else {
-        return eval_success(NIL(gc));
+    bool sorted = true;
+
+    while (!nil_p(xs) && sorted) {
+        long int x2 = 0;
+        result = match_list(gc, "d*", xs, &x2, NULL);
+        if (result.is_error) {
+            return result;
+        }
+
+        sorted = sorted && (x1 > x2);
+        args = xs;
+
+        result = match_list(gc, "d*", args, &x1, &xs);
+        if (result.is_error) {
+            return result;
+        }
     }
+
+    return eval_success(bool_as_expr(gc, sorted));
 }
 
 static struct EvalResult
 list_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
     (void) param;
 
     return eval_success(args);
@@ -64,8 +110,8 @@ static struct EvalResult
 plus_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     long int result = 0L;
 
@@ -85,12 +131,37 @@ plus_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
     return eval_success(NUMBER(gc, result));
 }
 
+static struct EvalResult
+mul_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
+{
+    (void) param;
+    trace_assert(gc);
+    trace_assert(scope);
+
+    long int result = 1L;
+
+    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
 assoc_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     struct Expr key = NIL(gc);
     struct Expr alist = NIL(gc);
@@ -106,8 +177,8 @@ static struct EvalResult
 set(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     const char *name = NULL;
     struct Expr value = void_expr();
@@ -130,8 +201,8 @@ static struct EvalResult
 quote(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     struct Expr expr = void_expr();
     struct EvalResult result = match_list(gc, "e", args, &expr);
@@ -146,8 +217,8 @@ static struct EvalResult
 begin(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     struct Expr block = void_expr();
     struct EvalResult result = match_list(gc, "*", args, &block);
@@ -162,8 +233,8 @@ static struct EvalResult
 defun(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     struct Expr name = void_expr();
     struct Expr args_list = void_expr();
@@ -174,19 +245,21 @@ defun(void *param, Gc *gc, struct Scope *scope, struct Expr args)
         return result;
     }
 
+    if (!list_of_symbols_p(args_list)) {
+        return wrong_argument_type(gc, "list-of-symbolsp", args_list);
+    }
+
     return eval(gc, scope,
-                list(gc, 3,
-                     SYMBOL(gc, "set"),
-                     name,
-                     lambda(gc, args_list, body)));
+                list(gc, "qee", "set", name,
+                            lambda(gc, args_list, body, scope)));
 }
 
 static struct EvalResult
 when(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     struct Expr condition = void_expr();
     struct Expr body = void_expr();
@@ -213,8 +286,8 @@ static struct EvalResult
 lambda_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 {
     (void) param;
-    assert(gc);
-    assert(scope);
+    trace_assert(gc);
+    trace_assert(scope);
 
     struct Expr args_list = void_expr();
     struct Expr body = void_expr();
@@ -228,7 +301,29 @@ lambda_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
         return wrong_argument_type(gc, "list-of-symbolsp", args_list);
     }
 
-    return eval_success(lambda(gc, args_list, body));
+    return eval_success(lambda(gc, args_list, body, scope));
+}
+
+static struct EvalResult
+load(void *param, Gc *gc, struct Scope *scope, struct Expr args)
+{
+    (void) param;
+    trace_assert(gc);
+    trace_assert(scope);
+
+    const char *filename = NULL;
+    struct EvalResult result = match_list(gc, "s", args, &filename);
+    if (result.is_error) {
+        return result;
+    }
+
+    struct ParseResult parse_result = read_all_exprs_from_file(gc, filename);
+    if (parse_result.is_error) {
+        /* TODO(#599): (load) does not provide position of the parse error  */
+        return read_error(gc, parse_result.error_message, 0);
+    }
+
+    return eval_block(gc, scope, parse_result.expr);
 }
 
 void load_std_library(Gc *gc, struct Scope *scope)
@@ -236,6 +331,7 @@ 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));
+    set_scope_value(gc, scope, SYMBOL(gc, "*"), NATIVE(gc, mul_op, NULL));
     set_scope_value(gc, scope, SYMBOL(gc, "list"), NATIVE(gc, list_op, NULL));
     set_scope_value(gc, scope, SYMBOL(gc, "t"), SYMBOL(gc, "t"));
     set_scope_value(gc, scope, SYMBOL(gc, "nil"), SYMBOL(gc, "nil"));
@@ -248,4 +344,6 @@ void load_std_library(Gc *gc, struct Scope *scope)
     set_scope_value(gc, scope, SYMBOL(gc, "when"), NATIVE(gc, when, NULL));
     set_scope_value(gc, scope, SYMBOL(gc, "lambda"), NATIVE(gc, lambda_op, NULL));
     set_scope_value(gc, scope, SYMBOL(gc, "λ"), NATIVE(gc, lambda_op, NULL));
+    set_scope_value(gc, scope, SYMBOL(gc, "unquote"), NATIVE(gc, unquote, NULL));
+    set_scope_value(gc, scope, SYMBOL(gc, "load"), NATIVE(gc, load, NULL));
 }