add eval

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 {