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

replace some number predicates with c imples

This commit is contained in:
Yuichi Nishiwaki 2014-01-22 22:58:08 +09:00
parent 5dd66cbcd1
commit 2f965fa809
2 changed files with 57 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
piclib/built-in.scm
View File

@ -347,15 +347,6 @@
(export make-parameter
parameterize)
(define (any pred list)
(if (null? list)
#f
((lambda (it)
(if it
it
(any pred (cdr list))))
(pred (car list)))))
(define (every pred list)
(if (null? list)
#t
@ -370,21 +361,6 @@
;;; 6.2. Numbers
(define (zero? n)
(= n 0))
(define (positive? x)
(> x 0))
(define (negative? x)
(< x 0))
(define (odd? n)
(= 0 (floor-remainder n 2)))
(define (even? n)
(= 1 (floor-remainder n 2)))
(define (min x . args)
(let loop ((pivot x) (rest args))
(if (null? rest)
@ -429,8 +405,7 @@
(define (lcm n m)
(/ (* n m) (gcd n m)))
(export zero? positive? negative?
odd? even? min max
(export min max
floor/ truncate/
exact-integer-sqrt
gcd lcm)

56
src/number.c
View File

@ -133,6 +133,56 @@ DEFINE_ARITH_CMP(>, gt)
DEFINE_ARITH_CMP(<=, le)
DEFINE_ARITH_CMP(>=, ge)
static pic_value
pic_number_zero_p(pic_state *pic)
{
double f;
pic_get_args(pic, "f", &f);
return pic_bool_value(f == 0);
}
static pic_value
pic_number_positive_p(pic_state *pic)
{
double f;
pic_get_args(pic, "f", &f);
return pic_bool_value(f > 0);
}
static pic_value
pic_number_negative_p(pic_state *pic)
{
double f;
pic_get_args(pic, "f", &f);
return pic_bool_value(f < 0);
}
static pic_value
pic_number_odd_p(pic_state *pic)
{
int i;
pic_get_args(pic, "i", &i);
return pic_bool_value(i % 2 != 0);
}
static pic_value
pic_number_even_p(pic_state *pic)
{
int i;
pic_get_args(pic, "i", &i);
return pic_bool_value(i % 2 == 0);
}
#define DEFINE_ARITH_OP(op, name, unit) \
static pic_value \
pic_number_##name(pic_state *pic) \
@ -526,6 +576,12 @@ pic_init_number(pic_state *pic)
pic_defun(pic, ">=", pic_number_ge);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "zero?", pic_number_zero_p);
pic_defun(pic, "positive?", pic_number_positive_p);
pic_defun(pic, "negative?", pic_number_negative_p);
pic_defun(pic, "odd?", pic_number_odd_p);
pic_defun(pic, "even?", pic_number_even_p);
pic_defun(pic, "+", pic_number_add);
pic_defun(pic, "-", pic_number_sub);
pic_defun(pic, "*", pic_number_mul);