Evaluation!

4 files changed, 138 insertions, 24 deletions

diff --git a/src/main.c b/src/main.c
index d543acf..a45da38 100644
--- a/src/main.c
+++ b/src/main.c
@@ -5,33 +5,41 @@
 #include "parser.h"
 #include "runtime.h"
 
+pit_value test_print(pit_runtime *rt, pit_value args) {
+    pit_value x = pit_car(rt, args);
+    pit_trace(rt, x);
+    return x;
+}
+
 pit_value test_add(pit_runtime *rt, pit_value args) {
     i64 x = pit_as_integer(rt, pit_car(rt, args));
     i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
     return pit_integer_new(rt, x + y);
 }
 
+pit_value test_sub(pit_runtime *rt, pit_value args) {
+    i64 x = pit_as_integer(rt, pit_car(rt, args));
+    i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args)));
+    return pit_integer_new(rt, x - y);
+}
+
 int main(int argc, char **argv) {
     if (argc < 2) pit_panic("usage: %s FILE", argv[0]);
-    pit_lexer *lex = pit_lex_file(argv[1]);
-    /* pit_lex_token t; */
-    /* while ((t = pit_lex_next(lex)) > PIT_LEX_TOKEN_EOF) { */
-    /*     printf("%s ", pit_lex_token_name(t)); */
-    /* } */
-    /* puts(pit_lex_token_name(t)); */
 
     pit_runtime *rt = pit_runtime_new();
     pit_check_error_maybe_panic(rt);
-    // pit_fset(rt, pit_intern_cstr(rt, "add"), pit_nativefunc_new(rt, test_add));
-    // pit_trace(rt, pit_list(rt, 2, pit_integer_new(rt, 1), pit_integer_new(rt, 2)));
-    // pit_trace(rt, pit_cons(rt, pit_cons(rt, pit_integer_new(rt, 1), pit_bytes_new_cstr(rt, "foobarbaz")), pit_cons(rt, pit_integer_new(rt, 2), pit_integer_new(rt, 3))));
-    // pit_check_error_maybe_panic(rt);
-    // pit_value res = pit_apply(rt, pit_fget(rt, pit_intern_cstr(rt, "add")), pit_list(rt, 2, pit_integer_new(rt, 1), pit_integer_new(rt, 2)));
-    // pit_check_error_maybe_panic(rt);
-    // pit_trace(rt, res);
+    pit_fset(rt, pit_intern_cstr(rt, "print"), pit_nativefunc_new(rt, test_print));
+    pit_fset(rt, pit_intern_cstr(rt, "+"), pit_nativefunc_new(rt, test_add));
+    pit_fset(rt, pit_intern_cstr(rt, "-"), pit_nativefunc_new(rt, test_sub));
+
+    pit_lexer *lex = pit_lex_file(argv[1]);
 
     pit_parser *parse = pit_parser_from_lexer(lex);
-    pit_value v = pit_parse(rt, parse);
+    pit_value program = pit_parse(rt, parse);
+    pit_check_error_maybe_panic(rt);
+    pit_trace(rt, program);
+
+    pit_value ret = pit_eval(rt, program);
     pit_check_error_maybe_panic(rt);
-    pit_trace(rt, v);
+    pit_trace(rt, ret);
 }
diff --git a/src/parser.c b/src/parser.c
index 99efe03..34472d2 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -49,7 +49,6 @@ pit_parser *pit_parser_from_lexer(pit_lexer *lex) {
 pit_value pit_parse(pit_runtime *rt, pit_parser *st) {
     char buf[256] = {0};
     pit_lex_token t = advance(st);
-    printf("token: %s\n", pit_lex_token_name(t));
     switch (t) {
     case PIT_LEX_TOKEN_ERROR:
         pit_error(rt, "encountered an error token while parsing");
diff --git a/src/runtime.c b/src/runtime.c
index ba5d131..abfd480 100644
--- a/src/runtime.c
+++ b/src/runtime.c
@@ -231,22 +231,41 @@ pit_value_heavy *pit_deref(pit_runtime *rt, pit_ref p) {
     return pit_arena_idx(rt->values, p);
 }
 
-bool pit_is_cons(pit_runtime *rt, pit_value a) {
+bool pit_is_integer(pit_runtime *rt, pit_value a) {
+    (void) rt;
+    return pit_value_sort(a) == PIT_VALUE_SORT_INTEGER;
+}
+bool pit_is_double(pit_runtime *rt, pit_value a) {
+    (void) rt;
+    return pit_value_sort(a) == PIT_VALUE_SORT_DOUBLE;
+}
+bool pit_is_symbol(pit_runtime *rt, pit_value a) {
+    (void) rt;
+    return pit_value_sort(a) == PIT_VALUE_SORT_SYMBOL;
+}
+bool pit_is_value_heavy_sort(pit_runtime *rt, pit_value a, enum pit_value_heavy_sort e) {
     switch (pit_value_sort(a)) {
     case PIT_VALUE_SORT_REF:
         pit_value_heavy *ha = pit_deref(rt, a);
         if (!ha) { pit_error(rt, "bad ref"); return false; }
-        switch (ha->hsort) {
-        case PIT_VALUE_HEAVY_SORT_CONS:
-            return true;
-        default:
-            break;
-        }
+        return ha->hsort == e;
     default:
         break;
     }
     return false;
 }
+bool pit_is_cons(pit_runtime *rt, pit_value a) {
+    return pit_is_value_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_CONS);
+}
+bool pit_is_array(pit_runtime *rt, pit_value a) {
+    return pit_is_value_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_ARRAY);
+}
+bool pit_is_bytes(pit_runtime *rt, pit_value a) {
+    return pit_is_value_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_BYTES);
+}
+bool pit_is_nativefunc(pit_runtime *rt, pit_value a) {
+    return pit_is_value_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_NATIVEFUNC);
+}
 bool pit_eq(pit_value a, pit_value b) {
     return a == b;
 }
@@ -427,3 +446,80 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) {
         return PIT_NIL;
     }
 }
+
+struct eval_stack {
+    i64 top, cap;
+    pit_value *data;
+};
+static struct eval_stack *eval_stack_new() {
+    struct eval_stack *ret = malloc(sizeof(*ret));
+    ret->top = 0;
+    ret->cap = 32;
+    ret->data = calloc(ret->cap, sizeof(pit_value));
+    return ret;
+}
+static void eval_stack_destroy(struct eval_stack *s) {
+    if (s) {
+        if (s->data) free(s->data);
+        free(s);
+    }
+}
+static void eval_stack_push(pit_runtime *rt, struct eval_stack *s, pit_value x) {
+    (void) rt;
+    s->data[s->top++] = x;
+    if (s->top >= s->cap) s->data = realloc(s->data, (s->cap <<= 1) * sizeof(pit_value));
+}
+static pit_value eval_stack_pop(pit_runtime *rt, struct eval_stack *s) {
+    if (s->top == 0) { pit_error(rt, "evaluation stack underflow"); return PIT_NIL; }
+    return s->data[--s->top];
+}
+
+pit_value pit_eval(pit_runtime *rt, pit_value top) {
+    struct eval_stack *expr_stack = eval_stack_new();
+    struct eval_stack *program = eval_stack_new();
+    eval_stack_push(rt, expr_stack, top);
+    // first, convert the expression tree into "polish notation" in program
+    while (expr_stack->top > 0) {
+        pit_value cur = eval_stack_pop(rt, expr_stack);
+        if (pit_is_cons(rt, cur)) { // compound expressions: function/macro application special forms
+            pit_value fsym = pit_car(rt, cur);
+            pit_value f = pit_fget(rt, fsym);
+            pit_value args = pit_cdr(rt, cur);
+            i64 argcount = 0;
+            while (args != PIT_NIL) {
+                eval_stack_push(rt, expr_stack, pit_car(rt, args));
+                args = pit_cdr(rt, args);
+                argcount += 1;
+            }
+            eval_stack_push(rt, program, pit_cons(rt, f, pit_integer_new(rt, argcount)));
+        } else if (pit_is_symbol(rt, cur)) { // unquoted symbols: variable lookup
+            eval_stack_push(rt, program, pit_get(rt, cur));
+        } else if (pit_is_double(rt, cur)) { // double literals
+            eval_stack_push(rt, program, cur);
+        } else if (pit_is_integer(rt, cur)) { // integer literals
+            eval_stack_push(rt, program, cur);
+        } else {
+            pit_error(rt, "unknown expression in eval");
+            goto end;
+        }
+    }
+    struct eval_stack *result_stack = eval_stack_new();
+    // then, execute the polish notation program from right to left
+    for (i64 idx = program->top - 1; idx >= 0; --idx) {
+        pit_value expr = program->data[idx];
+        if (pit_is_cons(rt, expr)) { // this is a function call
+            pit_value args = PIT_NIL;
+            for (i64 i = 0; i < pit_as_integer(rt, pit_cdr(rt, expr)); ++i) {
+                args = pit_cons(rt, eval_stack_pop(rt, result_stack), args);
+            }
+            eval_stack_push(rt, result_stack, pit_apply(rt, pit_car(rt, expr), args));
+        } else { // this is an atom
+            eval_stack_push(rt, result_stack, expr);
+        }
+    }
+end:
+    pit_value ret = eval_stack_pop(rt, result_stack);
+    eval_stack_destroy(expr_stack);
+    eval_stack_destroy(result_stack);
+    return ret;
+}
diff --git a/src/runtime.h b/src/runtime.h
index dcdb274..e652205 100644
--- a/src/runtime.h
+++ b/src/runtime.h
@@ -29,7 +29,7 @@ u64 pit_value_data(pit_value v);
 struct pit_runtime;
 typedef pit_value (*pit_nativefunc)(struct pit_runtime *rt, pit_value args);
 typedef struct { // "heavy" values, the targets of refs
-    enum {
+    enum pit_value_heavy_sort {
         PIT_VALUE_HEAVY_SORT_CONS=0,
         PIT_VALUE_HEAVY_SORT_ARRAY,
         PIT_VALUE_HEAVY_SORT_BYTES,
@@ -80,7 +80,14 @@ pit_value pit_heavy_new(pit_runtime *rt);
 pit_value_heavy *pit_deref(pit_runtime *rt, pit_ref p);
 
 // convenient predicates
+bool pit_is_integer(pit_runtime *rt, pit_value a);
+bool pit_is_double(pit_runtime *rt, pit_value a);
+bool pit_is_symbol(pit_runtime *rt, pit_value a);
+bool pit_is_value_heavy_sort(pit_runtime *rt, pit_value a, enum pit_value_heavy_sort e);
 bool pit_is_cons(pit_runtime *rt, pit_value a);
+bool pit_is_array(pit_runtime *rt, pit_value a);
+bool pit_is_bytes(pit_runtime *rt, pit_value a);
+bool pit_is_nativefunc(pit_runtime *rt, pit_value a);
 bool pit_truthful(pit_value a);
 bool pit_eq(pit_value a, pit_value b);
 bool pit_equal(pit_runtime *rt, pit_value a, pit_value b);
@@ -108,4 +115,8 @@ pit_value pit_cdr(pit_runtime *rt, pit_value v);
 // working with functions
 pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f);
 pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args);
+
+// evaluation!
+pit_value pit_eval(pit_runtime *rt, pit_value e);
+
 #endif