summaryrefslogtreecommitdiff
path: root/pit/src/library.c
diff options
context:
space:
mode:
Diffstat (limited to 'pit/src/library.c')
-rw-r--r--pit/src/library.c99
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));