aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/builtins.c157
-rw-r--r--src/builtins.h6
-rw-r--r--src/interp.c32
-rw-r--r--src/interp.h2
-rw-r--r--src/primitives.c24
-rw-r--r--src/primitives.h2
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
generated by cgit v1.0 at 2025-12-29 19:12:39 +0000