✨ comparison operators, ✅ acceptance tests.

features/cmp.mk

@@ -0,0 +1,24 @@
+(assert-eqv! true (< 1 2))
+(assert-eqv! false (< 2 2))
+(assert-eqv! false (< 3 2))
+
+(assert-eqv! true (<= 1 2))
+(assert-eqv! true (<= 2 2))
+(assert-eqv! false (<= 3 2))
+
+(assert-eqv! true (> 3 2))
+(assert-eqv! false (> 3 3))
+(assert-eqv! false (> 3 21))
+
+(assert-eqv! true (>= 3 2))
+(assert-eqv! true (>= 3 3))
+(assert-eqv! false (>= 3 21))
+
+(assert-eqv! false (eqv? 3 2))
+(assert-eqv! true (eqv? 3 3))
+
+(assert-eqv! false (eqv? [2 4] [2 5]))
+(assert-eqv! true (eqv? [2 4] [2 4]))
+
+(assert-eqv! true (nev? [2 4] [2 5]))
+(assert-eqv! false (nev? [2 4] [2 4]))

features/run.sh

@@ -0,0 +1,30 @@
+#!/bin/bash
+
+TOTAL=0
+FAILURES=0
+
+for file in $(find . -name "*.mk")
+do
+    OUTPUT=$(moka $file 2>&1)
+    
+    STATUS=$?
+
+    echo -en "\e[35m$file\e[0m ... "
+    if [ $STATUS -eq 0 ]
+    then
+        echo -e "\e[32mpassed\e[0m"
+    else
+        echo -e "\e[31mfailed\e[0m"
+        echo "$OUTPUT"
+        FAILURES=$(($FAILURES + 1))
+    fi
+
+    TOTAL=$(($TOTAL + 1))
+done
+
+if [ $FAILURES -eq 0 ]
+then
+    echo -e "\e[32m--- All tests passed ---\e[32m"
+else
+    echo -e "\e[31m--- $FAILURES tests failed ---\e[32m"
+fi

lib/builtins.c

@@ -7,10 +7,17 @@
 void register_builtins(struct moka* moka)
 {
     assert(moka);
-    moka_decl_native(moka, "println", mk_println);
+    moka_decl_native(moka, "println", mk_println, -1);
-    moka_decl_native(moka, "define", mk_define);
+    moka_decl_native(moka, "define", mk_define, 2);
-    moka_decl_native(moka, "array", mk_array);
+    moka_decl_native(moka, "array", mk_array, -1);
-    moka_decl_native(moka, "assert-eqv!", mk_assert_eqv_mut);
+    moka_decl_native(moka, "assert-eqv!", mk_assert_eqv_mut, 2);
+
+    moka_decl_native(moka, "<", mk_lt, 2);
+    moka_decl_native(moka, "<=", mk_le, 2);
+    moka_decl_native(moka, ">", mk_gt, 2);
+    moka_decl_native(moka, ">=", mk_ge, 2);
+    moka_decl_native(moka, "eqv?", mk_is_eqv, 2);
+    moka_decl_native(moka, "nev?", mk_is_nev, 2);
 }
 
 MOKA mk_println(struct moka* moka, struct vec* args)
@@ -93,3 +100,89 @@ MOKA mk_assert_eqv_mut(struct moka* moka, struct vec* args)
 
     return moka_push_bool(moka, true, line);
 }
+
+// Comparisons
+// ===========
+MOKA mk_lt(struct moka* moka, struct vec* args)
+{
+    assert(moka);
+    assert(args);
+
+    MOKA lhs = MK_EVAL((MOKA)args->data[0]);
+    MOKA rhs = MK_EVAL((MOKA)args->data[1]);
+
+    return moka_push_bool(
+        moka, moka_is_lt(moka, lhs, rhs),
+        moka_line(moka, lhs)
+    );
+}
+
+MOKA mk_le(struct moka* moka, struct vec* args)
+{
+    assert(moka);
+    assert(args);
+
+    MOKA lhs = MK_EVAL((MOKA)args->data[0]);
+    MOKA rhs = MK_EVAL((MOKA)args->data[1]);
+
+    return moka_push_bool(
+        moka, !moka_is_gt(moka, lhs, rhs),
+        moka_line(moka, lhs)
+    );
+}
+
+MOKA mk_gt(struct moka* moka, struct vec* args)
+{
+    assert(moka);
+    assert(args);
+
+    MOKA lhs = MK_EVAL((MOKA)args->data[0]);
+    MOKA rhs = MK_EVAL((MOKA)args->data[1]);
+
+    return moka_push_bool(
+        moka, moka_is_gt(moka, lhs, rhs),
+        moka_line(moka, lhs)
+    );
+}
+
+MOKA mk_ge(struct moka* moka, struct vec* args)
+{
+    assert(moka);
+    assert(args);
+
+    MOKA lhs = MK_EVAL((MOKA)args->data[0]);
+    MOKA rhs = MK_EVAL((MOKA)args->data[1]);
+
+    return moka_push_bool(
+        moka, !moka_is_lt(moka, lhs, rhs),
+        moka_line(moka, lhs)
+    );
+}
+
+MOKA mk_is_eqv(struct moka* moka, struct vec* args)
+{
+    assert(moka);
+    assert(args);
+
+    MOKA lhs = MK_EVAL((MOKA)args->data[0]);
+    MOKA rhs = MK_EVAL((MOKA)args->data[1]);
+
+    return moka_push_bool(
+        moka, moka_is_eqv(moka, lhs, rhs),
+        moka_line(moka, lhs)
+    );
+}
+
+MOKA mk_is_nev(struct moka* moka, struct vec* args)
+{
+    assert(moka);
+    assert(args);
+
+    MOKA lhs = MK_EVAL((MOKA)args->data[0]);
+    MOKA rhs = MK_EVAL((MOKA)args->data[1]);
+
+    return moka_push_bool(
+        moka, !moka_is_eqv(moka, lhs, rhs),
+        moka_line(moka, lhs)
+    );
+}

lib/builtins.h

@@ -13,4 +13,13 @@ MOKA mk_define(struct moka* moka, struct vec* args);
 MOKA mk_array(struct moka* moka, struct vec* args);
 MOKA mk_assert_eqv_mut(struct moka* moka, struct vec* args);
 
+// Comparisons
+// ===========
+MOKA mk_lt(struct moka* moka, struct vec* args);
+MOKA mk_le(struct moka* moka, struct vec* args);
+MOKA mk_gt(struct moka* moka, struct vec* args);
+MOKA mk_ge(struct moka* moka, struct vec* args);
+MOKA mk_is_eqv(struct moka* moka, struct vec* args);
+MOKA mk_is_nev(struct moka* moka, struct vec* args);
+
 #endif

lib/moka.c

@@ -100,7 +100,8 @@ void moka_import_module(struct moka* self,
                 moka_decl_native(
                     self,
                     new_name,
-                    val->data.native->fun
+                    val->data.native->fun,
+                    val->data.native->arity
                 );
             } break;
 
@@ -181,10 +182,11 @@ void moka_decl_var(struct moka* self,
 
 void moka_decl_native(struct moka* self,
                       char* name,
-                      native_fun_t fun)
+                      native_fun_t fun,
+                      int arity)
 {
     struct native* native = malloc(sizeof(struct native));
-    native_init(native, fun);
+    native_init(native, fun, arity);
 
     struct value* value = malloc(sizeof(struct value));
     value_init_native(value, native, 0);
@@ -252,6 +254,60 @@ size_t moka_str(struct moka* self, MOKA value,
     return value_str(val, buffer, size, self);
 }
 
+bool moka_is_lt(struct moka* self, MOKA mk_lhs, MOKA mk_rhs)
+{
+    struct frame* frame = moka_frame(self);
+    struct value* lhs = frame->local_values.data[mk_lhs];
+    struct value* rhs = frame->local_values.data[mk_rhs];
+
+    if (lhs->type != rhs->type)
+    {
+        return false;
+    }
+
+    switch (lhs->type)
+    {
+        case TY_INT: {
+            return lhs->data.integer < rhs->data.integer;
+        } break;
+        case TY_FLOAT: {
+            return lhs->data.real < rhs->data.real;
+        } break;
+        default: {
+            fprintf(stderr, "cannot compare type <%s>\n",
+                    TypeKindStr[lhs->type]);
+            abort();
+        } break;
+    }
+}
+
+bool moka_is_gt(struct moka* self, MOKA mk_lhs, MOKA mk_rhs)
+{
+    struct frame* frame = moka_frame(self);
+    struct value* lhs = frame->local_values.data[mk_lhs];
+    struct value* rhs = frame->local_values.data[mk_rhs];
+
+    if (lhs->type != rhs->type)
+    {
+        return false;
+    }
+
+    switch (lhs->type)
+    {
+        case TY_INT: {
+            return lhs->data.integer > rhs->data.integer;
+        } break;
+        case TY_FLOAT: {
+            return lhs->data.real > rhs->data.real;
+        } break;
+        default: {
+            fprintf(stderr, "cannot compare type <%s>\n",
+                    TypeKindStr[lhs->type]);
+            abort();
+        } break;
+    }
+}
+
 bool moka_is_eqv(struct moka* self, MOKA mk_lhs, MOKA mk_rhs)
 {
     struct frame* frame = moka_frame(self);
@@ -390,10 +446,12 @@ MOKA moka_call(struct moka* self, int arg_count)
     MOKA fun = moka_pop(self);
     struct vec args;
     vec_init(&args);
+    int line = 0;
 
     for (ssize_t i=0; i<arg_count; i++)
     {
         MOKA arg = moka_pop(self);
+        line = moka_line(self, arg);
         vec_push(&args, (void*) arg);
     }
 
@@ -403,6 +461,19 @@ MOKA moka_call(struct moka* self, int arg_count)
 
     assert(val->type == TY_NATIVE);
     struct native* native = val->data.native;
+
+    if (native->arity > 0 && arg_count != native->arity)
+    {
+        status_push(self->status, 
+                    STATUS_ERROR,
+                    line,
+                    "<%d> arguments expected, got <%d>",
+                    native->arity,
+                    arg_count);
+        vec_free(&args);
+        return moka_push_bool(self, false, line); 
+    }
+
     (native->fun)(self, &args);
 
     vec_free(&args);
@@ -544,13 +615,16 @@ size_t moka_get_ref(struct moka* self, MOKA value)
     return val->data.ref;
 }
 
-MOKA moka_push_native(struct moka* self, native_fun_t value, int line)
+MOKA moka_push_native(struct moka* self,
+                      native_fun_t value,
+                      int arity,
+                      int line)
 {
     assert(self);
     assert(value);
 
     struct native* native = malloc(sizeof(struct native));
-    native_init(native, value);
+    native_init(native, value, arity);
 
     struct value* val = malloc(sizeof(struct value));
     value_init_native(val, native, line);

lib/moka.h

@@ -51,7 +51,8 @@ void moka_decl_var(struct moka* self,
 
 void moka_decl_native(struct moka* self,
                       char* name,
-                      native_fun_t fun);
+                      native_fun_t fun,
+                      int arity);
 
 struct frame* moka_frame(struct moka* self);
 bool moka_has_top(struct moka* self);
@@ -61,6 +62,9 @@ MOKA moka_pop(struct moka* self);
 int moka_line(struct moka* self, MOKA value);
 size_t moka_str(struct moka* self, MOKA value, 
                 char* buffer, size_t size);
+
+bool moka_is_lt(struct moka* self, MOKA mk_lhs, MOKA mk_rhs);
+bool moka_is_gt(struct moka* self, MOKA mk_lhs, MOKA mk_rhs);
 bool moka_is_eqv(struct moka* self, MOKA mk_lhs, MOKA mk_rhs);
 
 bool moka_is(struct moka* self, MOKA value, TypeKind type);
@@ -91,7 +95,10 @@ char* moka_get_symbol(struct moka* self, MOKA value);
 MOKA moka_push_ref(struct moka* self, size_t value, int line);
 size_t moka_get_ref(struct moka* self, MOKA value);
 
-MOKA moka_push_native(struct moka* self, native_fun_t value, int line);
+MOKA moka_push_native(struct moka* self, 
+                      native_fun_t value, 
+                      int arity,
+                      int line);
 native_fun_t moka_get_native(struct moka* self, MOKA value);
 
 MOKA moka_eval_lazy(struct moka* self, MOKA lazy_value);

lib/native.c

@@ -1,9 +1,12 @@
 #include "native.h"
 
-void native_init(struct native* self, native_fun_t fun)
+void native_init(struct native* self,
+                 native_fun_t fun,
+                 int arity)
 {
     assert(self);
     self->fun = fun;
+    self->arity = arity;
 }
 
 void native_free(struct native* self)

lib/native.h

@@ -8,13 +8,15 @@ struct moka;
 
 typedef MOKA (*native_fun_t)(struct moka*, struct vec* args);
 
-
 struct native 
 {
     native_fun_t fun;
+    int arity;
 };
 
-void native_init(struct native* self, native_fun_t fun);
+void native_init(struct native* self, 
+                 native_fun_t fun, 
+                 int arity);
 void native_free(struct native* self);
 
 #endif