conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

rewrite floor/ and truncate/ in c

This commit is contained in:
Yuichi Nishiwaki 2014-07-22 09:07:09 +09:00
parent b834553c34
commit 3caf070043
2 changed files with 43 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
piclib/prelude.scm
View File

@ -591,14 +591,6 @@
;;; 6.2. Numbers
(define (floor/ n m)
(values (floor-quotient n m)
(floor-remainder n m)))
(define (truncate/ n m)
(values (truncate-quotient n m)
(truncate-remainder n m)))
; (import (only (scheme inexact) sqrt))
(import (scheme inexact))

43
src/number.c
View File

@ -8,6 +8,7 @@
#include "picrin.h"
#include "picrin/string.h"
#include "picrin/cont.h"
static int
gcd(int a, int b)
@ -381,6 +382,26 @@ pic_number_floor_remainder(pic_state *pic)
}
}
static pic_value
pic_number_floor2(pic_state *pic)
{
int i, j;
bool e1, e2;
double q, r;
pic_get_args(pic, "II", &i, &e1, &j, &e2);
q = floor((double)i/j);
r = i - j * q;
if (e1 && e2) {
return pic_values2(pic, pic_int_value(q), pic_int_value(r));
}
else {
return pic_values2(pic, pic_float_value(q), pic_float_value(r));
}
}
static pic_value
pic_number_trunc_quotient(pic_state *pic)
{
@ -414,6 +435,26 @@ pic_number_trunc_remainder(pic_state *pic)
}
}
static pic_value
pic_number_trunc2(pic_state *pic)
{
int i, j;
bool e1, e2;
double q, r;
pic_get_args(pic, "II", &i, &e1, &j, &e2);
q = trunc((double)i/j);
r = i - j * q;
if (e1 && e2) {
return pic_values2(pic, pic_int_value(q), pic_int_value(r));
}
else {
return pic_values2(pic, pic_float_value(q), pic_float_value(r));
}
}
static pic_value
pic_number_gcd(pic_state *pic)
{
@ -780,8 +821,10 @@ pic_init_number(pic_state *pic)
pic_defun(pic, "abs", pic_number_abs);
pic_defun(pic, "floor-quotient", pic_number_floor_quotient);
pic_defun(pic, "floor-remainder", pic_number_floor_remainder);
pic_defun(pic, "floor/", pic_number_floor2);
pic_defun(pic, "truncate-quotient", pic_number_trunc_quotient);
pic_defun(pic, "truncate-remainder", pic_number_trunc_remainder);
pic_defun(pic, "truncate/", pic_number_trunc2);
pic_defun(pic, "modulo", pic_number_floor_remainder);
pic_defun(pic, "quotient", pic_number_trunc_quotient);
pic_defun(pic, "remainder", pic_number_trunc_remainder);