diff options
Diffstat (limited to 'pit/src/library.c')
| -rw-r--r-- | pit/src/library.c | 62 |
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 */ |