aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp.c183
-rw-r--r--src/interp.h39
-rw-r--r--src/parser.c4
-rw-r--r--src/sexp.h1
4 files changed, 204 insertions, 23 deletions
diff --git a/src/interp.c b/src/interp.c
index bf49dd5..b350bdf 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -1,10 +1,23 @@
#include "interp.h"
-#include "algds/hash_table.h"
+
+#include <stdarg.h>
+
+#include <algds/hash_table.h>
+
#include "sexp.h"
+#define BUFSIZE 1024
+
+#define REF(x) (Interp_ref(interp, (x)))
+
+void PrimitiveEntry_show(PrimitiveEntry self, FILE *fp) { }
+VECTOR_IMPL(PrimitiveEntry);
+
void Interp_init(Interp *self) {
+ self->errmsg_buf = malloc(BUFSIZE);
SExpVector_init(&self->objs);
IntVector_init(&self->empty_space);
+ PrimitiveEntryVector_init(&self->primitives);
String2IntHashTable_init(&self->symbols);
self->gc_paused = false;
SExp sexp;
@@ -24,7 +37,13 @@ void Interp_init(Interp *self) {
}
self->evaluating = self->nil;
- self->stack = cons(self, self->top_level, self->nil);
+ self->stack = lisp_cons(self, self->top_level, self->nil);
+
+ Interp_add_primitive(self, "car", primitive_car);
+ Interp_add_primitive(self, "cdr", primitive_cdr);
+ Interp_add_primitive(self, "cons", primitive_cons);
+ Interp_add_primitive(self, "add", primitive_add);
+ Interp_add_primitive(self, "sub", primitive_sub);
}
void Interp_free(Interp *self) {
@@ -37,6 +56,8 @@ void Interp_free(Interp *self) {
String2IntHashTable_free(&self->symbols);
SExpVector_free(&self->objs);
IntVector_free(&self->empty_space);
+ PrimitiveEntryVector_free(&self->primitives);
+ free(self->errmsg_buf);
}
SExp* Interp_ref(Interp *self, SExpRef ref) {
@@ -45,10 +66,133 @@ SExp* Interp_ref(Interp *self, SExpRef ref) {
return res;
}
+void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn) {
+ PrimitiveEntryVector_push_back(&self->primitives, (PrimitiveEntry){
+ .name = name,
+ .fn = fn
+ });
+}
+
void Interp_gc(Interp *interp) {
// TODO
}
+SExpRef lisp_cons(Interp *interp, SExpRef car, SExpRef cdr) {
+ SExpRef ret = new_sexp(interp);
+ SExp *psexp = Interp_ref(interp, ret);
+ psexp->type = kPairSExp;
+ psexp->pair.car = car;
+ psexp->pair.cdr = cdr;
+ return ret;
+}
+
+SExpRef lisp_dup(Interp *interp, SExpRef val) {
+ SExpRef ret = new_sexp(interp);
+ *REF(ret) = *REF(val);
+ return ret;
+}
+
+SExpRef lisp_cadr(Interp *interp, SExpRef val) {
+ return lisp_car(interp, lisp_cdr(interp, val));
+}
+SExpRef lisp_cddr(Interp *interp, SExpRef val) {
+ return lisp_cdr(interp, lisp_cdr(interp, val));
+}
+SExpRef lisp_caddr(Interp *interp, SExpRef val) {
+ return lisp_car(interp, lisp_cddr(interp, val));
+}
+SExpRef lisp_cdddr(Interp *interp, SExpRef val) {
+ return lisp_cdr(interp, lisp_cddr(interp, val));
+}
+SExpRef lisp_cadddr(Interp *interp, SExpRef val) {
+ return lisp_car(interp, lisp_cdddr(interp, val));
+}
+SExpRef lisp_cddddr(Interp *interp, SExpRef val) {
+ return lisp_cdr(interp, lisp_cdddr(interp, val));
+}
+
+SExpRef lisp_car(Interp *interp, SExpRef val) {
+ if (REF(val)->type != kPairSExp) {
+ return new_error(interp, "type error: car.\n");
+ }
+ return REF(val)->pair.car;
+}
+
+SExpRef lisp_cdr(Interp *interp, SExpRef val) {
+ if (REF(val)->type != kPairSExp) {
+ return new_error(interp, "type error: cdr.\n");
+ }
+ return REF(val)->pair.cdr;
+}
+
+bool lisp_check_list(Interp *interp, SExpRef val) {
+
+}
+
+SExpRef lisp_lookup(Interp *interp, const char *name) {
+ // TODO
+}
+
+SExpRef lisp_check_argnum(Interp *interp, const char *name, int num, SExpRef args) {
+ // TODO
+ return interp->nil;
+}
+
+SExpRef primitive_car(Interp *interp, SExpRef args) {
+ SExpRef check = lisp_check_argnum(interp, "car", 1, args);
+ if (REF(check)->type == kErrSExp) return args;
+ args = lisp_eval_args(interp, args);
+ if (REF(args)->type == kErrSExp) return args;
+ return lisp_car(interp, lisp_car(interp, args));
+}
+
+SExpRef primitive_cdr(Interp *interp, SExpRef args) {
+ SExpRef check = lisp_check_argnum(interp, "cdr", 1, args);
+ if (REF(check)->type == kErrSExp) return args;
+ args = lisp_eval_args(interp, args);
+ if (REF(args)->type == kErrSExp) return args;
+ return lisp_cdr(interp, lisp_car(interp, args));
+}
+
+SExpRef lisp_eval(Interp *interp, SExpRef val) {
+ SExpType type;
+ type = REF(val)->type;
+ if (type == kEnvSExp || type == kEnvSExp || type == kBindingSExp) {
+ return new_error(interp, "type error: cannot eval.\n");
+ }
+ if (type == kIntegerSExp
+ || type == kStringSExp
+ || type == kBooleanSExp
+ || type == kCharSExp
+ || type == kErrSExp
+ || type == kFuncSExp
+ || type == kRealSExp) {
+ return val;
+ }
+ if (type == kSymbolSExp) {
+ return lisp_lookup(interp, REF(val)->str);
+ }
+ if (type == kPairSExp) {
+ if (!lisp_check_list(interp, val)) {
+ return new_error(interp, "eval: list not proper.\n");
+ }
+ SExpRef hd = lisp_car(interp, (lisp_car(interp, val)));
+ if (REF(hd)->type != kSymbolSExp) {
+ return new_error(interp, "eval: first elem must be a symbol.\n");
+ }
+ const char *symbol = REF(hd)->str;
+ for (int i = 0; i < PrimitiveEntryVector_len(&interp->primitives); i++) {
+ if (strcmp(symbol, PrimitiveEntryVector_ref(&interp->primitives, i)->name) == 0) {
+ LispPrimitive primitive_fn =
+ PrimitiveEntryVector_ref(&interp->primitives, i)->fn;
+ return (*primitive_fn)(interp, lisp_cdr(interp, val));
+ }
+ // TODO: macro / func
+ }
+ }
+ return interp->nil;
+}
+
SExpRef new_sexp(Interp *interp) {
if (IntVector_len(&interp->empty_space) == 0) {
if (interp->gc_paused) {
@@ -65,9 +209,19 @@ SExpRef new_sexp(Interp *interp) {
SExpRef new_boolean(Interp *interp, bool val) {
SExpRef ret = new_sexp(interp);
- SExp *psexp = Interp_ref(interp, ret);
- psexp->type = kBooleanSExp;
- psexp->boolean = val;
+ REF(ret)->type = kBooleanSExp;
+ REF(ret)->boolean = val;
+ return ret;
+}
+
+SExpRef new_error(Interp *interp, const char *format, ...) {
+ va_list args;
+ va_start(args, format);
+ vsnprintf(interp->errmsg_buf, BUFSIZE, format, args);
+ va_end(args);
+ SExpRef ret = new_sexp(interp);
+ REF(ret)->type = kErrSExp;
+ REF(ret)->boolean = interp->errmsg_buf;
return ret;
}
@@ -119,32 +273,23 @@ SExpRef new_symbol(Interp *interp, const char *val) {
}
}
-SExpRef cons(Interp *interp, SExpRef car, SExpRef cdr) {
- SExpRef ret = new_sexp(interp);
- SExp *psexp = Interp_ref(interp, ret);
- psexp->type = kPairSExp;
- psexp->pair.car = car;
- psexp->pair.cdr = cdr;
- return ret;
-}
-
SExpRef new_list1(Interp *interp, SExpRef e1) {
- return cons(interp, e1, interp->nil);
+ return lisp_cons(interp, e1, interp->nil);
}
SExpRef new_list2(Interp *interp, SExpRef e1, SExpRef e2) {
- return cons(interp, e1, new_list1(interp, e2));
+ return lisp_cons(interp, e1, new_list1(interp, e2));
}
SExpRef new_list3(Interp *interp, SExpRef e1, SExpRef e2, SExpRef e3) {
- return cons(interp, e1, new_list2(interp, e2, e3));
+ return lisp_cons(interp, e1, new_list2(interp, e2, e3));
}
SExpRef new_list4(Interp *interp, SExpRef e1, SExpRef e2, SExpRef e3, SExpRef e4) {
- return cons(interp, e1, new_list3(interp, e2, e3, e4));
+ return lisp_cons(interp, e1, new_list3(interp, e2, e3, e4));
}
SExpRef new_list5(Interp *interp, SExpRef e1, SExpRef e2, SExpRef e3, SExpRef e4, SExpRef e5) {
- return cons(interp, e1, new_list4(interp, e2, e3, e4, e5));
+ return lisp_cons(interp, e1, new_list4(interp, e2, e3, e4, e5));
}
diff --git a/src/interp.h b/src/interp.h
index 6ec1c6d..b82fcd7 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -5,18 +5,35 @@
#include <algds/hash_table.h>
+#include "algds/vec.h"
#include "sexp.h"
+
+struct interp;
+typedef struct interp Interp;
+
+typedef SExpRef (*LispPrimitive)(Interp *interp, SExpRef sexp);
+
typedef struct {
+ const char *name;
+ LispPrimitive fn;
+} PrimitiveEntry;
+
+VECTOR_DEF(PrimitiveEntry);
+
+struct interp {
bool gc_paused;
SExpVector objs;
+ PrimitiveEntryVector primitives;
IntVector empty_space;
String2IntHashTable symbols;
SExpRef stack;
SExpRef evaluating;
SExpRef top_level;
SExpRef nil;
-} Interp;
+ char *errmsg_buf;
+};
+
void Interp_init(Interp *self);
void Interp_free(Interp *self);
@@ -24,7 +41,26 @@ SExp* Interp_ref(Interp *self, SExpRef ref);
void Interp_gc(Interp *self);
void Interp_pause_gc(Interp *self);
void Interp_restart_gc(Interp *self);
+void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn);
+
+SExpRef primitive_car(Interp *interp, SExpRef sexp);
+SExpRef primitive_cdr(Interp *interp, SExpRef sexp);
+SExpRef primitive_cons(Interp *interp, SExpRef sexp);
+SExpRef primitive_add(Interp *interp, SExpRef sexp);
+SExpRef primitive_sub(Interp *interp, SExpRef sexp);
+
+SExpRef lisp_cons(Interp *ctx, SExpRef car, SExpRef cdr);
+SExpRef lisp_dup(Interp *ctx, SExpRef val);
+SExpRef lisp_car(Interp *ctx, SExpRef val);
+SExpRef lisp_cdr(Interp *ctx, SExpRef val);
+SExpRef lisp_eval(Interp *ctx, SExpRef val);
+SExpRef lisp_eval_args(Interp *ctx, SExpRef val);
+SExpRef lisp_add(Interp *ctx, SExpRef lhs, SExpRef rhs);
+SExpRef lisp_sub(Interp *ctx, SExpRef lhs, SExpRef rhs);
+SExpRef lisp_mul(Interp *ctx, SExpRef lhs, SExpRef rhs);
+SExpRef lisp_div(Interp *ctx, SExpRef lhs, SExpRef rhs);
+SExpRef new_error(Interp *interp, const char *format, ...);
SExpRef new_sexp(Interp *ctx);
SExpRef new_boolean(Interp *ctx, bool val);
SExpRef new_char(Interp *ctx, char val);
@@ -32,7 +68,6 @@ SExpRef new_integer(Interp *ctx, int64_t val);
SExpRef new_real(Interp *ctx, double val);
SExpRef new_string(Interp *ctx, const char *val);
SExpRef new_symbol(Interp *ctx, const char *val);
-SExpRef cons(Interp *ctx, SExpRef car, SExpRef cdr);
SExpRef new_list1(Interp *ctx, SExpRef e1);
SExpRef new_list2(Interp *ctx, SExpRef e1, SExpRef e2);
SExpRef new_list3(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3);
diff --git a/src/parser.c b/src/parser.c
index f60946a..4f46c41 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -140,7 +140,7 @@ static SExpRef build_list_from_vector(Interp *ctx, SExpRefVector elems) {
i--;
for (; i >= 0; i--) {
SExpRef cur = *SExpRefVector_ref(&elems, i);
- ret = cons(ctx, cur, ret);
+ ret = lisp_cons(ctx, cur, ret);
}
return ret;
}
@@ -332,7 +332,7 @@ ParseResult parse_abbrev(Parser *parser, const char *name) {
ret = parse_sexp(parser);
if (ParseResult_is_err(ret)) return ret;
SExpRef sym = new_symbol(parser->ctx, name);
- return ParseOk(cons(parser->ctx, sym, ret.val));
+ return ParseOk(lisp_cons(parser->ctx, sym, ret.val));
}
ParseResult parse_quote(Parser *parser) {
diff --git a/src/sexp.h b/src/sexp.h
index 92ff11b..22b2c8a 100644
--- a/src/sexp.h
+++ b/src/sexp.h
@@ -56,6 +56,7 @@ typedef enum {
kEnvSExp,
kBindingSExp,
kMacroSExp,
+ kErrSExp,
} SExpType;
struct sexp {
generated by cgit v1.0 at 2025-12-29 17:48:30 +0000