eq, equal

3 files changed, 43 insertions, 5 deletions

diff --git a/src/builtins.c b/src/builtins.c
index 9a35f52..198f80d 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -3,6 +3,44 @@
 #include "sexp.h"
 #include <algds/str.h>
 
+static bool equal_impl(Interp *interp, SExpRef x, SExpRef y) {
+    if (VALTYPE(x) != VALTYPE(y)) return false;
+    if (VALTYPE(x) == kIntegerSExp) {
+        return REF(x)->integer== REF(y)->integer;
+    } else if (VALTYPE(x) == kRealSExp) {
+        return REF(x)->real == REF(y)->real;
+    } else if (VALTYPE(x) == kStringSExp) {
+        return strcmp(REF(x)->str, REF(y)->str) == 0;
+    } else if (VALTYPE(x) == kPairSExp) {
+        return equal_impl(interp, REF(x)->pair.car, REF(y)->pair.car)
+                && equal_impl(interp, REF(x)->pair.cdr, REF(y)->pair.cdr);
+    } else if (VALTYPE(x) == kCharSExp) {
+        return REF(x)->character == REF(y)->character;
+    } else if (VALTYPE(x) == kUserDataSExp) {
+        return REF(x)->userdata == REF(y)->userdata;
+    }
+    return x.idx == y.idx;
+}
+
+SExpRef builtin_eq(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "eq: expect 2 args.\n");
+    SExpRef x = CAR(args), y = CADR(args);
+    if (VALTYPE(x) != VALTYPE(y)) return new_boolean(interp, false);
+    if (VALTYPE(x) == kIntegerSExp
+            || VALTYPE(x) == kCharSExp 
+            || VALTYPE(x) == kRealSExp) {
+        return new_boolean(interp, equal_impl(interp, x ,y));
+    }
+    return new_boolean(interp, x.idx == y.idx);
+}
+
+
+SExpRef builtin_equal(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 2) return new_error(interp, "equal: expect 2 args.\n");
+    SExpRef x = CAR(args), y = CADR(args);
+    return new_boolean(interp, equal_impl(interp, x, y));
+}
+
 SExpRef builtin_format(Interp *interp, SExpRef args) {
     if (NILP(args)) {
         return new_error(interp, "format: too few arguments (missing format string).\n");
diff --git a/src/interp.c b/src/interp.c
index f055bce..d7e06ed 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -86,6 +86,8 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "assert-error", primitive_assert_error);
     Interp_add_primitive(self, "load", primitive_load);
 
+    Interp_add_userfunc(self, "eq", builtin_eq);
+    Interp_add_userfunc(self, "equal", builtin_equal);
     Interp_add_userfunc(self, "format", builtin_format);
     Interp_add_userfunc(self, "concat", builtin_concat);
     Interp_add_userfunc(self, "error", builtin_error);
@@ -627,8 +629,10 @@ SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail) {
             iter = CDR(iter);
         }
     } else if (VALTYPE(fn) == kUserFuncSExp) {
-        LispUserFunc fnptr = REF(fn)->userfunc;
+        LispUserFunc  fnptr = REF(fn)->userfunc;
+        PUSH_REG(args);
         ret = (*fnptr)(interp, args);
+        POP_REG();
         return ret;
     }
 end:
diff --git a/src/primitives.c b/src/primitives.c
index 92e8110..a0a90a0 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -357,9 +357,7 @@ SExpRef primitive_funcall(Interp *interp, SExpRef args, bool istail) {
     if (LENGTH(args) < 1) goto error;
     args = lisp_eval_args(interp, args);
     if (CTL_FL(args)) return args;
-    PUSH_REG(args);
     SExpRef ret = lisp_apply(interp, CAR(args), CDR(args), istail);
-    POP_REG();
     return ret;
 error:
     return new_error(interp, "funcall: syntax error.\n");
@@ -390,9 +388,7 @@ SExpRef primitive_apply(Interp *interp, SExpRef args, bool istail) {
     args = lisp_eval_args(interp, args);
     if (CTL_FL(args)) return args;
     if (!lisp_check_list(interp, CADR(args))) goto error;
-    PUSH_REG(args);
     ret = lisp_apply(interp, CAR(args), CADR(args), istail);
-    POP_REG();
     return ret;
 error:
     return new_error(interp, "apply: syntax error.\n");