pit: Better double support

1 files changed, 62 insertions, 0 deletions

diff --git a/pit/src/library.c b/pit/src/library.c
index 10f56f4..098c6f9 100644
--- a/pit/src/library.c
+++ b/pit/src/library.c
@@ -283,6 +283,16 @@ static pit_value impl_symbol_p(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
     return pit_value_bool_new(rt, pit_value_is_symbol(rt, pit_value_cons_car(rt, args)));
 }
+static pit_value impl_integer_to_double(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    i64 x = pit_value_as_integer(rt, pit_value_cons_car(rt, args));
+    return pit_value_double_new(rt, (double) x);
+}
+static pit_value impl_double_to_integer(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    double x = pit_value_as_double(rt, pit_value_cons_car(rt, args));
+    return pit_value_integer_new(rt, (i64) x);
+}
 static pit_value impl_cons_p(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
     return pit_value_bool_new(rt, pit_value_is_cons(rt, pit_value_cons_car(rt, args)));
@@ -683,6 +693,50 @@ static pit_value impl_mod(pit_runtime *rt, pit_value args, void *data) {
     i64 y = pit_value_as_integer(rt, pit_value_cons_car(rt, pit_value_cons_cdr(rt, args)));
     return pit_value_integer_new(rt, x % y);
 }
+static pit_value impl_double_abs(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    double x = pit_value_as_double(rt, pit_value_cons_car(rt, args));
+    if (x < 0) return pit_value_double_new(rt, -x);
+    return pit_value_double_new(rt, x);
+}
+static pit_value impl_double_add(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    double total = 0;
+    while (args != PIT_NIL) {
+        total += pit_value_as_double(rt, pit_value_cons_car(rt, args));
+        args = pit_value_cons_cdr(rt, args);
+    }
+    return pit_value_double_new(rt, total);
+}
+static pit_value impl_double_sub(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    double total = 0;
+    while (args != PIT_NIL) {
+        total -= pit_value_as_double(rt, pit_value_cons_car(rt, args));
+        args = pit_value_cons_cdr(rt, args);
+    }
+    return pit_value_double_new(rt, total);
+}
+static pit_value impl_double_mul(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    double total = 1;
+    while (args != PIT_NIL) {
+        total *= pit_value_as_double(rt, pit_value_cons_car(rt, args));
+        args = pit_value_cons_cdr(rt, args);
+    }
+    return pit_value_double_new(rt, total);
+}
+static pit_value impl_double_div(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    double total = pit_value_as_double(rt, pit_value_cons_car(rt, args));
+    args = pit_value_cons_cdr(rt, args);
+    while (args != PIT_NIL) {
+        double denom = pit_value_as_double(rt, pit_value_cons_car(rt, args));
+        total /= denom;
+        args = pit_value_cons_cdr(rt, args);
+    }
+    return pit_value_double_new(rt, total);
+}
 static pit_value impl_not(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
     if (pit_value_cons_car(rt, args) == PIT_NIL) {
@@ -786,6 +840,9 @@ void pit_install_library_essential(pit_runtime *rt) {
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "array?"), pit_value_nativefunc_new(rt, impl_array_p));
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "bytes?"), pit_value_nativefunc_new(rt, impl_bytes_p));
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "function?"), pit_value_nativefunc_new(rt, impl_function_p));
+    /* conversions */
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "integer->double"), pit_value_nativefunc_new(rt, impl_integer_to_double));
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "double->integer"), pit_value_nativefunc_new(rt, impl_double_to_integer));
     /* symbols */
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "set!"), pit_value_nativefunc_new(rt, impl_set));
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "fset!"), pit_value_nativefunc_new(rt, impl_fset));
@@ -836,6 +893,11 @@ void pit_install_library_essential(pit_runtime *rt) {
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "*"), pit_value_nativefunc_new(rt, impl_mul));
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "/"), pit_value_nativefunc_new(rt, impl_div));
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "%"), pit_value_nativefunc_new(rt, impl_mod));
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "double/abs"), pit_value_nativefunc_new(rt, impl_double_abs));
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "double/+"), pit_value_nativefunc_new(rt, impl_double_add));
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "double/-"), pit_value_nativefunc_new(rt, impl_double_sub));
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "double/*"), pit_value_nativefunc_new(rt, impl_double_mul));
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "double//"), pit_value_nativefunc_new(rt, impl_double_div));
     /* booleans */
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "not"), pit_value_nativefunc_new(rt, impl_not));
     /* comparisons */