pit: VM-style evaluation

1 files changed, 55 insertions, 44 deletions

diff --git a/pit/src/library.c b/pit/src/library.c
index cbe7f71..e70a705 100644
--- a/pit/src/library.c
+++ b/pit/src/library.c
@@ -6,65 +6,64 @@
 
 static pit_value impl_sf_quote(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
-    pit_traversal_push_value(rt, rt->traversal, pit_value_cons_car(rt, args));
+    pit_traversal_push_value(rt, rt->traversal,
+        pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "literal"), pit_value_cons_car(rt, args))
+    );
     return PIT_NIL;
 }
 static pit_value impl_sf_if(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
-    pit_value c = pit_value_cons_car(rt, args);
-    if (pit_eval(rt, c) != PIT_NIL) {
-        if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, args))) < 0)
-            pit_error(rt, "in special form \"if\": evaluation stack overflow");
-    } else {
-        if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, pit_value_cons_cdr(rt, args)))) < 0)
-            pit_error(rt, "in special form \"if\": evaluation stack overflow");
-    }
+    // TODO
+    // pit_value c = pit_value_cons_car(rt, args);
+    // if (pit_eval(rt, c) != PIT_NIL) {
+    //     if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, args))) < 0)
+    //         pit_error(rt, "in special form \"if\": evaluation stack overflow");
+    // } else {
+    //     if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons_car(rt, pit_value_cons_cdr(rt, pit_value_cons_cdr(rt, args)))) < 0)
+    //         pit_error(rt, "in special form \"if\": evaluation stack overflow");
+    // }
     return PIT_NIL;
 }
 static pit_value impl_sf_cond(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
-    while (args != PIT_NIL) {
-        pit_value clause = pit_value_cons_car(rt, args);
-        pit_value cond = pit_value_cons_car(rt, clause);
-        if (pit_eval(rt, cond) != PIT_NIL) {
-            if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_cons_cdr(rt, clause))) < 0)
-                pit_error(rt, "in special form \"cond\": evaluation stack overflow");
-            return PIT_NIL;
-        }
-        args = pit_value_cons_cdr(rt, args);
-    }
-    if (pit_vec_push(pit_value)(rt->expr_stack, PIT_NIL) < 0)
-        pit_error(rt, "in special form \"cond\": evaluation stack overflow");
-    return PIT_NIL;
-}
-static pit_value impl_sf_progn(pit_runtime *rt, pit_value args, void *data) {
-    (void) data;
-    pit_value bodyforms = args;
-    pit_value final = PIT_NIL;
-    while (bodyforms != PIT_NIL) {
-        final = pit_eval(rt, pit_value_cons_car(rt, bodyforms));
-        bodyforms = pit_value_cons_cdr(rt, bodyforms);
-    }
-    pit_traversal_push_value(rt, rt->traversal, final);
+    // TODO
+    // while (args != PIT_NIL) {
+    //     pit_value clause = pit_value_cons_car(rt, args);
+    //     pit_value cond = pit_value_cons_car(rt, clause);
+    //     if (pit_eval(rt, cond) != PIT_NIL) {
+    //         if (pit_vec_push(pit_value)(rt->expr_stack, pit_value_cons(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_cons_cdr(rt, clause))) < 0)
+    //             pit_error(rt, "in special form \"cond\": evaluation stack overflow");
+    //         return PIT_NIL;
+    //     }
+    //     args = pit_value_cons_cdr(rt, args);
+    // }
+    // if (pit_vec_push(pit_value)(rt->expr_stack, PIT_NIL) < 0)
+    //     pit_error(rt, "in special form \"cond\": evaluation stack overflow");
     return PIT_NIL;
 }
 static pit_value impl_sf_or(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
-    pit_value bodyforms = args;
-    pit_value final = PIT_NIL;
-    while (bodyforms != PIT_NIL) {
-        final = pit_eval(rt, pit_value_cons_car(rt, bodyforms));
-        if (final != PIT_NIL) break;
-        bodyforms = pit_value_cons_cdr(rt, bodyforms);
-    }
-    pit_traversal_push_value(rt, rt->traversal, final);
+    // TODO
+    // pit_value bodyforms = args;
+    // pit_value final = PIT_NIL;
+    // while (bodyforms != PIT_NIL) {
+    //     final = pit_eval(rt, pit_value_cons_car(rt, bodyforms));
+    //     if (final != PIT_NIL) break;
+    //     bodyforms = pit_value_cons_cdr(rt, bodyforms);
+    // }
+    // pit_traversal_push_value(rt, rt->traversal, final);
     return PIT_NIL;
 }
 static pit_value impl_sf_lambda(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
     pit_value as = pit_value_cons_car(rt, args);
     pit_value body = pit_value_cons_cdr(rt, args);
-    pit_traversal_push_value(rt, rt->traversal, pit_value_func_lambda(rt, as, body));
+    pit_traversal_push_value(rt, rt->traversal,
+        pit_value_list(rt, 2,
+            pit_symtab_intern_cstr(rt, "literal"),
+            pit_value_func_lambda(rt, as, body)
+        )
+    );
     return PIT_NIL;
 }
 static pit_value impl_m_defun(pit_runtime *rt, pit_value args, void *data) {
@@ -246,6 +245,16 @@ static pit_value impl_m_case(pit_runtime *rt, pit_value args, void *data) {
         pit_value_cons(rt, pit_symtab_intern_cstr(rt, "cond"), pit_value_list_reverse(rt, clauses))
     );
 }
+
+static pit_value impl_progn(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    pit_value ret = PIT_NIL;
+    while (args != PIT_NIL) {
+        ret = pit_value_cons_car(rt, args);
+        args = pit_value_cons_cdr(rt, args);
+    }
+    return ret;
+}
 static pit_value impl_set(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
     pit_value sym = pit_value_cons_car(rt, args);
@@ -287,7 +296,9 @@ static pit_value impl_error(pit_runtime *rt, pit_value args, void *data) {
 }
 static pit_value impl_eval(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
-    return pit_eval(rt, pit_value_cons_car(rt, args));
+    // TODO
+    return PIT_NIL;
+    // return pit_eval(rt, pit_value_cons_car(rt, args));
 }
 static pit_value impl_eq_p(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
@@ -790,7 +801,6 @@ void pit_install_library_essential(pit_runtime *rt) {
     pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "quote"), pit_value_nativefunc_new(rt, impl_sf_quote));
     pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "if"), pit_value_nativefunc_new(rt, impl_sf_if));
     pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "cond"), pit_value_nativefunc_new(rt, impl_sf_cond));
-    pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_nativefunc_new(rt, impl_sf_progn));
     pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "or"), pit_value_nativefunc_new(rt, impl_sf_or));
     pit_symtab_sfset(rt, pit_symtab_intern_cstr(rt, "lambda"), pit_value_nativefunc_new(rt, impl_sf_lambda));
     /* macros */
@@ -803,7 +813,8 @@ void pit_install_library_essential(pit_runtime *rt) {
     pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "case"), pit_value_nativefunc_new(rt, impl_m_case));
     /* error */
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "error!"), pit_value_nativefunc_new(rt, impl_error));
-    /* eval */
+    /* basics */
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "progn"), pit_value_nativefunc_new(rt, impl_progn));
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "eval!"), pit_value_nativefunc_new(rt, impl_eval));
     /* predicates */
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "eq?"), pit_value_nativefunc_new(rt, impl_eq_p));