rewrite min/max/gcd/lcm with C

This commit is contained in:
Yuichi Nishiwaki 2014-01-22 23:47:33 +09:00
parent 2f965fa809
commit 95c5361197
2 changed files with 138 additions and 33 deletions

View File

@ -361,18 +361,6 @@
;;; 6.2. Numbers
(define (min x . args)
(let loop ((pivot x) (rest args))
(if (null? rest)
pivot
(loop (if (< pivot (car rest)) pivot (car rest)) (cdr rest)))))
(define (max x . args)
(let loop ((pivot x) (rest args))
(if (null? rest)
pivot
(loop (if (> pivot (car rest)) pivot (car rest)) (cdr rest)))))
(define (floor/ n m)
(values (floor-quotient n m)
(floor-remainder n m)))
@ -388,27 +376,8 @@
(let ((n (exact (floor (sqrt k)))))
(values n (- k (square n)))))
(define (gcd n m)
(if (negative? n)
(set! n (- n)))
(if (negative? m)
(set! m (- m)))
(if (> n m)
((lambda (tmp)
(set! n m)
(set! m tmp))
n))
(if (zero? n)
m
(gcd (floor-remainder m n) n)))
(define (lcm n m)
(/ (* n m) (gcd n m)))
(export min max
floor/ truncate/
exact-integer-sqrt
gcd lcm)
(export floor/ truncate/
exact-integer-sqrt)
;;; 6.3 Booleans

View File

@ -4,9 +4,28 @@
#include <math.h>
#include <limits.h>
#include <stdlib.h>
#include "picrin.h"
static int
gcd(int a, int b)
{
if (a > b)
return gcd(b, a);
if (a < 0)
return gcd(-a, b);
if (a > 0)
return gcd(b % a, a);
return b;
}
static int
lcm(int a, int b)
{
return abs(a * b) / gcd(a, b);
}
static pic_value
pic_number_real_p(pic_state *pic)
{
@ -183,6 +202,62 @@ pic_number_even_p(pic_state *pic)
return pic_bool_value(i % 2 == 0);
}
static pic_value
pic_number_max(pic_state *pic)
{
size_t argc;
pic_value *argv;
int i;
double f;
bool e = true;
pic_get_args(pic, "*", &argc, &argv);
f = -INFINITY;
for (i = 0; i < argc; ++i) {
if (pic_int_p(argv[i])) {
f = fmax(f, pic_int(argv[i]));
}
else if (pic_float_p(argv[i])) {
e = false;
f = fmax(f, pic_float(argv[i]));
}
else {
pic_error(pic, "min: number required");
}
}
return e ? pic_int_value(f) : pic_float_value(f);
}
static pic_value
pic_number_min(pic_state *pic)
{
size_t argc;
pic_value *argv;
int i;
double f;
bool e = true;
pic_get_args(pic, "*", &argc, &argv);
f = INFINITY;
for (i = 0; i < argc; ++i) {
if (pic_int_p(argv[i])) {
f = fmin(f, pic_int(argv[i]));
}
else if (pic_float_p(argv[i])) {
e = false;
f = fmin(f, pic_float(argv[i]));
}
else {
pic_error(pic, "min: number required");
}
}
return e ? pic_int_value(f) : pic_float_value(f);
}
#define DEFINE_ARITH_OP(op, name, unit) \
static pic_value \
pic_number_##name(pic_state *pic) \
@ -333,6 +408,58 @@ pic_number_trunc_remainder(pic_state *pic)
}
}
static pic_value
pic_number_gcd(pic_state *pic)
{
size_t argc;
pic_value *args;
int r;
bool e = true;
pic_get_args(pic, "*", &argc, &args);
r = 0;
while (argc-- > 0) {
if (pic_int_p(args[argc])) {
r = gcd(r, pic_int(args[argc]));
}
else if (pic_float_p(args[argc])) {
e = false;
r = gcd(r, pic_float(args[argc]));
}
else {
pic_error(pic, "gcd: number required");
}
}
return e ? pic_int_value(r) : pic_float_value(r);
}
static pic_value
pic_number_lcm(pic_state *pic)
{
size_t argc;
pic_value *args;
int r;
bool e = true;
pic_get_args(pic, "*", &argc, &args);
r = 1;
while (argc-- > 0) {
if (pic_int_p(args[argc])) {
r = lcm(r, pic_int(args[argc]));
}
else if (pic_float_p(args[argc])) {
e = false;
r = lcm(r, pic_float(args[argc]));
}
else {
pic_error(pic, "lcm: number required");
}
}
return e ? pic_int_value(r) : pic_float_value(r);
}
static pic_value
pic_number_floor(pic_state *pic)
{
@ -581,6 +708,11 @@ pic_init_number(pic_state *pic)
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_gc_arena_restore(pic, ai);
pic_defun(pic, "min", pic_number_min);
pic_defun(pic, "max", pic_number_max);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "+", pic_number_add);
pic_defun(pic, "-", pic_number_sub);
@ -595,6 +727,10 @@ pic_init_number(pic_state *pic)
pic_defun(pic, "truncate-remainder", pic_number_trunc_remainder);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "gcd", pic_number_gcd);
pic_defun(pic, "lcm", pic_number_lcm);
pic_gc_arena_restore(pic, ai);
pic_defun(pic, "floor", pic_number_floor);
pic_defun(pic, "ceiling", pic_number_ceil);
pic_defun(pic, "truncate", pic_number_trunc);