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.c126
1 files changed, 46 insertions, 80 deletions
diff --git a/pit/src/library.c b/pit/src/library.c
index e70a705..6e87255 100644
--- a/pit/src/library.c
+++ b/pit/src/library.c
@@ -4,68 +4,6 @@
#include <lcq/pit/runtime.h>
#include <lcq/pit/library.h>
-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_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;
- // 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;
- // 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;
- // 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_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) {
(void) data;
pit_value nm = pit_value_cons_car(rt, args);
@@ -77,6 +15,7 @@ static pit_value impl_m_defun(pit_runtime *rt, pit_value args, void *data) {
pit_value_cons(rt, pit_symtab_intern_cstr(rt, "lambda"), pit_value_cons(rt, as, body))
);
}
+
static pit_value impl_m_defmacro(pit_runtime *rt, pit_value args, void *data) {
(void) data;
pit_value nm = pit_value_cons_car(rt, args);
@@ -86,6 +25,7 @@ static pit_value impl_m_defmacro(pit_runtime *rt, pit_value args, void *data) {
pit_value_list(rt, 2, pit_symtab_intern_cstr(rt, "set-symbol-macro!"), nm)
);
}
+
static pit_value impl_m_defstruct(pit_runtime *rt, pit_value args, void *data) {
(void) data;
pit_value ret = PIT_NIL;
@@ -192,6 +132,7 @@ static pit_value impl_m_let(pit_runtime *rt, pit_value args, void *data) {
application = pit_value_cons(rt, lambda, largs);
return application;
}
+
static pit_value impl_m_and(pit_runtime *rt, pit_value args, void *data) {
(void) data;
pit_value ret = PIT_NIL;
@@ -201,11 +142,24 @@ static pit_value impl_m_and(pit_runtime *rt, pit_value args, void *data) {
args = pit_value_cons_cdr(rt, args);
}
while (args != PIT_NIL) {
- ret = pit_value_list(rt, 3, pit_symtab_intern_cstr(rt, "if"), pit_value_cons_car(rt, args), ret, PIT_NIL);
+ ret = pit_value_list(rt, 4, pit_symtab_intern_cstr(rt, "if"), pit_value_cons_car(rt, args), ret, PIT_NIL);
+ args = pit_value_cons_cdr(rt, args);
+ }
+ return ret;
+}
+
+static pit_value impl_m_or(pit_runtime *rt, pit_value args, void *data) {
+ (void) data;
+ pit_value ret = PIT_NIL;
+ args = pit_value_list_reverse(rt, args);
+ while (args != PIT_NIL) {
+ pit_value v = pit_value_cons_car(rt, args);
+ ret = pit_value_list(rt, 4, pit_symtab_intern_cstr(rt, "if"), v, v, ret);
args = pit_value_cons_cdr(rt, args);
}
return ret;
}
+
static pit_value impl_m_setq(pit_runtime *rt, pit_value args, void *data) {
(void) data;
pit_value sym = pit_value_cons_car(rt, args);
@@ -217,6 +171,22 @@ static pit_value impl_m_setq(pit_runtime *rt, pit_value args, void *data) {
);
}
+static pit_value impl_m_cond(pit_runtime *rt, pit_value args, void *data) {
+ (void) data;
+ pit_value ret = PIT_NIL;
+ pit_value clauses = pit_value_list_reverse(rt, args);
+ while (clauses != PIT_NIL) {
+ pit_value c = pit_value_cons_car(rt, clauses);
+ ret = pit_value_list(rt, 4, pit_symtab_intern_cstr(rt, "if"),
+ pit_value_cons_car(rt, c),
+ pit_value_cons_car(rt, pit_value_cons_cdr(rt, c)),
+ ret
+ );
+ clauses = pit_value_cons_cdr(rt, clauses);
+ }
+ return ret;
+}
+
// (case x (y 'foo) (z 'bar))
// (cond ((eq x 'y) 'foo) ((eq x 'z) 'bar))
static pit_value impl_m_case(pit_runtime *rt, pit_value args, void *data) {
@@ -224,7 +194,7 @@ static pit_value impl_m_case(pit_runtime *rt, pit_value args, void *data) {
pit_value x = pit_value_cons_car(rt, args);
pit_value cases = pit_value_cons_cdr(rt, args);
pit_value clauses = PIT_NIL;
- pit_value xvar = pit_symtab_intern_cstr(rt, "(internal case)");
+ pit_value xvar = pit_symtab_intern_cstr(rt, "<<internal case>>");
while (cases != PIT_NIL) {
pit_value c = pit_value_cons_car(rt, cases);
clauses = pit_value_cons(rt,
@@ -278,13 +248,13 @@ static pit_value impl_symbol_mark_macro(pit_runtime *rt, pit_value args, void *d
static pit_value impl_funcall(pit_runtime *rt, pit_value args, void *data) {
(void) data;
pit_value f = pit_value_cons_car(rt, args);
- return pit_value_apply(rt, f, pit_value_cons_cdr(rt, args));
+ return pit_vm_apply(rt, f, pit_value_cons_cdr(rt, args));
}
static pit_value impl_apply(pit_runtime *rt, pit_value args, void *data) {
(void) data;
pit_value f = pit_value_cons_car(rt, args);
pit_value xs = pit_value_cons_car(rt, pit_value_cons_cdr(rt, args));
- return pit_value_apply(rt, f, xs);
+ return pit_vm_apply(rt, f, xs);
}
static pit_value impl_error(pit_runtime *rt, pit_value args, void *data) {
(void) data;
@@ -460,7 +430,7 @@ static pit_value impl_list_map(pit_runtime *rt, pit_value args, void *data) {
pit_value xs = pit_value_cons_car(rt, pit_value_cons_cdr(rt, args));
pit_value ret = PIT_NIL;
while (xs != PIT_NIL) {
- pit_value y = pit_value_apply(rt, func, pit_value_cons(rt, pit_value_cons_car(rt, xs), PIT_NIL));
+ pit_value y = pit_vm_apply(rt, func, pit_value_cons(rt, pit_value_cons_car(rt, xs), PIT_NIL));
ret = pit_value_cons(rt, y, ret);
xs = pit_value_cons_cdr(rt, xs);
}
@@ -472,7 +442,7 @@ static pit_value impl_list_foldl(pit_runtime *rt, pit_value args, void *data) {
pit_value acc = pit_value_cons_car(rt, pit_value_cons_cdr(rt, args));
pit_value xs = pit_value_cons_car(rt, pit_value_cons_cdr(rt, pit_value_cons_cdr(rt, args)));
while (xs != PIT_NIL) {
- acc = pit_value_apply(rt, func, pit_value_list(rt, 2, pit_value_cons_car(rt, xs), acc));
+ acc = pit_vm_apply(rt, func, pit_value_list(rt, 2, pit_value_cons_car(rt, xs), acc));
xs = pit_value_cons_cdr(rt, xs);
}
return acc;
@@ -484,7 +454,7 @@ static pit_value impl_list_filter(pit_runtime *rt, pit_value args, void *data) {
pit_value ret = PIT_NIL;
while (xs != PIT_NIL) {
pit_value x = pit_value_cons_car(rt, xs);
- pit_value y = pit_value_apply(rt, func, pit_value_cons(rt, x, PIT_NIL));
+ pit_value y = pit_vm_apply(rt, func, pit_value_cons(rt, x, PIT_NIL));
if (y != PIT_NIL) {
ret = pit_value_cons(rt, x, ret);
}
@@ -498,7 +468,7 @@ static pit_value impl_list_find(pit_runtime *rt, pit_value args, void *data) {
pit_value xs = pit_value_cons_car(rt, pit_value_cons_cdr(rt, args));
while (xs != PIT_NIL) {
pit_value x = pit_value_cons_car(rt, xs);
- pit_value y = pit_value_apply(rt, func, pit_value_cons(rt, x, PIT_NIL));
+ pit_value y = pit_vm_apply(rt, func, pit_value_cons(rt, x, PIT_NIL));
if (y != PIT_NIL) {
return x;
}
@@ -522,7 +492,7 @@ static pit_value impl_list_all_p(pit_runtime *rt, pit_value args, void *data) {
pit_value xs = pit_value_cons_car(rt, pit_value_cons_cdr(rt, args));
while (xs != PIT_NIL) {
pit_value x = pit_value_cons_car(rt, xs);
- if (pit_value_apply(rt, f, pit_value_cons(rt, x, PIT_NIL)) == PIT_NIL) {
+ if (pit_vm_apply(rt, f, pit_value_cons(rt, x, PIT_NIL)) == PIT_NIL) {
return PIT_NIL;
}
xs = pit_value_cons_cdr(rt, xs);
@@ -536,7 +506,7 @@ static pit_value impl_list_zip_with(pit_runtime *rt, pit_value args, void *data)
pit_value ys = pit_value_cons_car(rt, pit_value_cons_cdr(rt, pit_value_cons_cdr(rt, args)));
pit_value ret = PIT_NIL;
while (xs != PIT_NIL && ys != PIT_NIL) {
- pit_value z = pit_value_apply(rt, f, pit_value_list(rt, 2, pit_value_cons_car(rt, xs), pit_value_cons_car(rt, ys)));
+ pit_value z = pit_vm_apply(rt, f, pit_value_list(rt, 2, pit_value_cons_car(rt, xs), pit_value_cons_car(rt, ys)));
ret = pit_value_cons(rt, z, ret);
xs = pit_value_cons_cdr(rt, xs); ys = pit_value_cons_cdr(rt, ys);
}
@@ -653,7 +623,7 @@ static pit_value impl_array_map(pit_runtime *rt, pit_value args, void *data) {
pit_value ret = pit_value_array_new(rt, len);
i64 i = 0;
for (i = 0; i < len; ++i) {
- pit_value y = pit_value_apply(rt, func, pit_value_cons(rt, pit_value_array_get(rt, arr, i), PIT_NIL));
+ pit_value y = pit_vm_apply(rt, func, pit_value_cons(rt, pit_value_array_get(rt, arr, i), PIT_NIL));
pit_value_array_set(rt, ret, i, y);
}
return ret;
@@ -665,7 +635,7 @@ static pit_value impl_array_map_mut(pit_runtime *rt, pit_value args, void *data)
i64 len = pit_value_array_len(rt, arr);
i64 i = 0;
for (i = 0; i < len; ++i) {
- pit_value y = pit_value_apply(rt, func, pit_value_cons(rt, pit_value_array_get(rt, arr, i), PIT_NIL));
+ pit_value y = pit_vm_apply(rt, func, pit_value_cons(rt, pit_value_array_get(rt, arr, i), PIT_NIL));
pit_value_array_set(rt, arr, i, y);
}
return arr;
@@ -797,19 +767,15 @@ static pit_value impl_bitwise_rshift(pit_runtime *rt, pit_value args, void *data
return pit_value_integer_new(rt, val);
}
void pit_install_library_essential(pit_runtime *rt) {
- /* special forms */
- 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, "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 */
pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "defun!"), pit_value_nativefunc_new(rt, impl_m_defun));
pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "defmacro!"), pit_value_nativefunc_new(rt, impl_m_defmacro));
pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "defstruct!"), pit_value_nativefunc_new(rt, impl_m_defstruct));
pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "let"), pit_value_nativefunc_new(rt, impl_m_let));
pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "and"), pit_value_nativefunc_new(rt, impl_m_and));
+ pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "or"), pit_value_nativefunc_new(rt, impl_m_or));
pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "setq!"), pit_value_nativefunc_new(rt, impl_m_setq));
+ pit_symtab_mset(rt, pit_symtab_intern_cstr(rt, "cond"), pit_value_nativefunc_new(rt, impl_m_cond));
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));
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-02 00:53:54 +0000