and/or/not

6 files changed, 216 insertions, 7 deletions

diff --git a/src/builtins.c b/src/builtins.c
index 2ad3916..abd2ae9 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -50,6 +50,20 @@ static SExp raw_add(SExp a, SExp b) {
     }
 }
 
+static SExp raw_mul(SExp a, SExp b) {
+    if (a.type == kRealSExp || b.type == kRealSExp) {
+        double result = 1.0;
+        if (a.type == kRealSExp) result += a.real;
+        else result *= a.integer;
+        if (b.type == kRealSExp) result += b.real;
+        else result *= b.integer;
+        return (SExp){ .type = kRealSExp, .real = result };
+    } else {
+        int64_t result;
+        return (SExp){ .type = kIntegerSExp, .integer= a.integer * b.integer};
+    }
+}
+
 static SExp raw_sub(SExp a, SExp b) {
     if (a.type == kRealSExp || b.type == kRealSExp) {
         double result = 0;
@@ -63,6 +77,29 @@ static SExp raw_sub(SExp a, SExp b) {
     }
 }
 
+static SExp raw_div(SExp a, SExp b) {
+    double lhs, rhs;
+    if (a.type == kRealSExp) lhs = a.real;
+    else lhs = a.integer;
+    if (b.type == kRealSExp) rhs = b.real;
+    else rhs = b.integer;
+    return (SExp){ .type = kRealSExp, .real = lhs / rhs};
+}
+
+static SExp raw_idiv(SExp a, SExp b) {
+    int64_t lhs, rhs;
+    lhs = a.integer;
+    rhs = b.integer;
+    return (SExp){ .type = kIntegerSExp, .integer = lhs / rhs};
+}
+
+static SExp raw_mod(SExp a, SExp b) {
+    int64_t lhs, rhs;
+    lhs = a.integer;
+    rhs = b.integer;
+    return (SExp){ .type = kIntegerSExp, .integer = lhs % rhs};
+}
+
 SExpRef builtin_add(Interp *interp, SExpRef args) {
     SExpRef ret;
     SExp acc = {.type = kIntegerSExp, .integer = 0};
@@ -83,6 +120,26 @@ SExpRef builtin_add(Interp *interp, SExpRef args) {
     return ret;
 }
 
+SExpRef builtin_mul(Interp *interp, SExpRef args) {
+    SExpRef ret;
+    SExp acc = {.type = kIntegerSExp, .integer = 1};
+    SExpRef cur = args;
+    while (!NILP(cur)) {
+        if (REF(CAR(cur))->type != kIntegerSExp && REF(CAR(cur))->type != kRealSExp) {
+            return new_error(interp, "*: wrong argument type.\n");
+        }
+        cur = CDR(cur);
+    }
+    cur = args;
+    while (!NILP(cur)) {
+        acc = raw_mul(acc, *REF(CAR(cur)));
+        cur = CDR(cur);
+    }
+    ret = new_sexp(interp);
+    *REF(ret) = acc;
+    return ret;
+}
+
 SExpRef builtin_sub(Interp *interp, SExpRef args) {
     SExpRef ret;
     SExpRef cur = args;
@@ -109,6 +166,77 @@ SExpRef builtin_sub(Interp *interp, SExpRef args) {
     return new_error(interp, "-: wrong argument number.\n");
 }
 
+SExpRef builtin_div(Interp *interp, SExpRef args) {
+    SExpRef ret;
+    SExpRef cur = args;
+    while (!NILP(cur)) {
+        if (REF(CAR(cur))->type != kIntegerSExp && REF(CAR(cur))->type != kRealSExp) {
+            return new_error(interp, "/: wrong argument type.\n");
+        }
+        cur = CDR(cur);
+    }
+    int args_len = lisp_length(interp, args);
+    if (args_len == 1) {
+        SExp num = *REF(CAR(args));
+        if (num.type == kIntegerSExp) {
+            return new_integer(interp, 1.0/num.integer);
+        }
+        return new_real(interp, 1.0/num.real);
+    }
+    if (args_len == 2) {
+        SExp num = raw_div(*REF(CAR(args)), *REF(CADR(args)));
+        ret = new_sexp(interp);
+        *REF(ret) = num;
+        return ret;
+    }
+    return new_error(interp, "/: wrong argument number.\n");
+}
+
+SExpRef builtin_idiv(Interp *interp, SExpRef args) {
+    SExpRef ret;
+    SExpRef cur = args;
+    while (!NILP(cur)) {
+        if (REF(CAR(cur))->type != kIntegerSExp) {
+            return new_error(interp, "i/: wrong argument type.\n");
+        }
+        cur = CDR(cur);
+    }
+    int args_len = lisp_length(interp, args);
+    if (args_len == 2) {
+        SExp num = raw_idiv(*REF(CAR(args)), *REF(CADR(args)));
+        ret = new_sexp(interp);
+        *REF(ret) = num;
+        return ret;
+    }
+    return new_error(interp, "i/: wrong argument number.\n");
+}
+
+SExpRef builtin_mod(Interp *interp, SExpRef args) {
+    SExpRef ret;
+    SExpRef cur = args;
+    while (!NILP(cur)) {
+        if (REF(CAR(cur))->type != kIntegerSExp) {
+            return new_error(interp, "mod: wrong argument type.\n");
+        }
+        cur = CDR(cur);
+    }
+    int args_len = lisp_length(interp, args);
+    if (args_len == 2) {
+        SExp num = raw_mod(*REF(CAR(args)), *REF(CADR(args)));
+        ret = new_sexp(interp);
+        *REF(ret) = num;
+        return ret;
+    }
+    return new_error(interp, "mod: wrong argument number.\n");
+}
+
+SExpRef builtin_not(Interp *interp, SExpRef args) {
+    int args_len = lisp_length(interp, args);
+    if (args_len != 1) return new_error(interp, "not: wrong argument number.\n");
+    if (TRUEP(CAR(args))) return interp->f;
+    return interp->t;
+}
+
 SExpRef builtin_num_equal(Interp *interp, SExpRef args) {
     int args_len = lisp_length(interp, args);
     if (args_len != 2) return new_error(interp, "=: wrong argument number.\n");
@@ -138,6 +266,35 @@ SExpRef builtin_num_equal(Interp *interp, SExpRef args) {
     }
 }
 
+SExpRef builtin_num_neq(Interp *interp, SExpRef args) {
+    int args_len = lisp_length(interp, args);
+    if (args_len != 2) return new_error(interp, "/=: wrong argument number.\n");
+    SExpRef lhs = CAR(args);
+    SExpRef rhs = CADR(args);
+    if (VALTYPE(lhs) != kRealSExp && VALTYPE(lhs) != kIntegerSExp) {
+        return new_error(interp, "/=: type error.\n");
+    }
+    if (VALTYPE(rhs) != kRealSExp && VALTYPE(rhs) != kIntegerSExp) {
+        return new_error(interp, "/=: type error.\n");
+    }
+    if (VALTYPE(lhs) == kRealSExp || VALTYPE(rhs) == kRealSExp) {
+        double flhs, frhs;
+        if (VALTYPE(lhs) == kIntegerSExp) {
+            flhs = REF(lhs)->integer;
+        } else {
+            flhs = REF(lhs)->real;
+        }
+        if (VALTYPE(rhs) == kIntegerSExp) {
+            frhs = REF(rhs)->integer;
+        } else {
+            frhs = REF(rhs)->real;
+        }
+        return new_boolean(interp, flhs != frhs);
+    } else {
+        return new_boolean(interp, REF(lhs)->integer != REF(rhs)->integer);
+    }
+}
+
 SExpRef builtin_gt(Interp *interp, SExpRef args) {
     int args_len = lisp_length(interp, args);
     if (args_len != 2) return new_error(interp, ">: wrong argument number.\n");
diff --git a/src/builtins.h b/src/builtins.h
index d4fcaf5..4e4e39f 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -7,11 +7,17 @@ SExpRef builtin_list(Interp *interp, SExpRef sexp);
 SExpRef builtin_car(Interp *interp, SExpRef sexp);
 SExpRef builtin_cdr(Interp *interp, SExpRef sexp);
 SExpRef builtin_cons(Interp *interp, SExpRef sexp);
+SExpRef builtin_not(Interp *interp, SExpRef sexp);
 
 SExpRef builtin_add(Interp *interp, SExpRef sexp);
 SExpRef builtin_sub(Interp *interp, SExpRef sexp);
+SExpRef builtin_mul(Interp *interp, SExpRef sexp);
+SExpRef builtin_div(Interp *interp, SExpRef sexp);
+SExpRef builtin_idiv(Interp *interp, SExpRef sexp);
+SExpRef builtin_mod(Interp *interp, SExpRef sexp);
 
 SExpRef builtin_num_equal(Interp *interp, SExpRef sexp);
+SExpRef builtin_num_neq(Interp *interp, SExpRef sexp);
 SExpRef builtin_gt(Interp *interp, SExpRef sexp);
 SExpRef builtin_lt(Interp *interp, SExpRef sexp);
 SExpRef builtin_ge(Interp *interp, SExpRef sexp);
diff --git a/src/interp.c b/src/interp.c
index 5e181a8..a28df21 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -23,18 +23,30 @@ void Interp_init(Interp *self) {
     IntVector_init(&self->empty_space);
     PrimitiveEntryVector_init(&self->primitives);
     String2IntHashTable_init(&self->symbols);
+    int i = 0;
     SExp sexp;
     sexp.type = kNilSExp;
     SExpVector_push_back(&self->objs, sexp);
-    self->nil = (SExpRef){0};
+    self->nil = (SExpRef){i}; i++;
 
     sexp.type = kEnvSExp;
     sexp.env.parent= self->nil;
     sexp.env.bindings = self->nil;
     SExpVector_push_back(&self->objs, sexp);
-    self->top_level = (SExpRef){1};
+    self->top_level = (SExpRef){i}; i++;
+
+    sexp.type = kBooleanSExp;
+    sexp.boolean = true;
+    SExpVector_push_back(&self->objs, sexp);
+    self->t= (SExpRef){i}; i++;
+
+    sexp.type = kBooleanSExp;
+    sexp.boolean = false;
+    SExpVector_push_back(&self->objs, sexp);
+    self->f = (SExpRef){i}; i++;
+
     sexp.type = kEmptySExp;
-    for (int i = 2; i < 1024; i++) {
+    for (; i < 1024; i++) {
         SExpVector_push_back(&self->objs, sexp);
         IntVector_push_back(&self->empty_space, i);
     }
@@ -58,6 +70,8 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "quote", primitive_quote);
     Interp_add_primitive(self, "quasiquote", primitive_quasi);
     Interp_add_primitive(self, "macroexpand-1", primitive_macroexpand1);
+    Interp_add_primitive(self, "and", primitive_and);
+    Interp_add_primitive(self, "or", primitive_or);
 
     Interp_add_userfunc(self, "eval", lisp_eval);
     Interp_add_userfunc(self, "show", builtin_show);
@@ -67,11 +81,17 @@ void Interp_init(Interp *self) {
     Interp_add_userfunc(self, "cons", builtin_cons);
     Interp_add_userfunc(self, "+", builtin_add);
     Interp_add_userfunc(self, "-", builtin_sub);
+    Interp_add_userfunc(self, "*", builtin_mul);
+    Interp_add_userfunc(self, "/", builtin_div);
+    Interp_add_userfunc(self, "i/", builtin_idiv);
+    Interp_add_userfunc(self, "mod", builtin_mod);
     Interp_add_userfunc(self, "=", builtin_num_equal);
+    Interp_add_userfunc(self, "/=", builtin_num_neq);
     Interp_add_userfunc(self, "<", builtin_lt);
     Interp_add_userfunc(self, ">", builtin_gt);
     Interp_add_userfunc(self, ">=", builtin_ge);
     Interp_add_userfunc(self, "<=", builtin_le);
+    Interp_add_userfunc(self, "not", builtin_not);
 }
 
 void Interp_add_userfunc(Interp *interp, const char *name, LispUserFunc fn) {
@@ -537,10 +557,8 @@ SExpRef new_binding(Interp *interp, SExpRef sym, SExpRef val) {
 }
 
 SExpRef new_boolean(Interp *interp, bool val) {
-    SExpRef ret = new_sexp(interp);
-    REF(ret)->type = kBooleanSExp;
-    REF(ret)->boolean = val;
-    return ret;
+    if (val) return interp->t;
+    return interp->f;
 }
 
 SExpRef new_error(Interp *interp, const char *format, ...) {
diff --git a/src/interp.h b/src/interp.h
index b7b3025..0564ee0 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -26,6 +26,8 @@ struct interp {
     IntVector empty_space;
     String2IntHashTable symbols;
     SExpRef stack;
+    SExpRef t;
+    SExpRef f;
     SExpRef reg;
     SExpRef top_level;
     SExpRef nil;
diff --git a/src/primitives.c b/src/primitives.c
index 266a8b7..510ca1e 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -327,6 +327,30 @@ SExpRef primitive_quasi(Interp *interp, SExpRef args) {
     return ret;
 }
 
+SExpRef primitive_and(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) < 1) return new_error(interp, "and: syntax error.\n");
+    SExpRef ret;
+    SExpRef i = args;
+    while (!NILP(i)) {
+        ret = EVAL(CAR(i));
+        if (!TRUEP(ret)) return ret;
+        i = CDR(i);
+    }
+    return ret;
+}
+
+SExpRef primitive_or(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) < 1) return new_error(interp, "or: syntax error.\n");
+    SExpRef ret;
+    SExpRef i = args;
+    while (!NILP(i)) {
+        ret = EVAL(CAR(i));
+        if (TRUEP(ret)) return ret;
+        i = CDR(i);
+    }
+    return ret;
+}
+
 // TODO:
 // - defmacro
 // - macroexpand-1
diff --git a/src/primitives.h b/src/primitives.h
index 0e6f061..7e6d559 100644
--- a/src/primitives.h
+++ b/src/primitives.h
@@ -19,5 +19,7 @@ SExpRef primitive_funcall(Interp *interp, SExpRef sexp);
 SExpRef primitive_apply(Interp *interp, SExpRef sexp);
 SExpRef primitive_quote(Interp *interp, SExpRef sexp);
 SExpRef primitive_quasi(Interp *interp, SExpRef sexp);
+SExpRef primitive_and(Interp *interp, SExpRef sexp);
+SExpRef primitive_or(Interp *interp, SExpRef sexp);
 
 #endif