rewrite min/max/gcd/lcm with C
This commit is contained in:
parent
2f965fa809
commit
95c5361197
|
@ -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
|
||||
|
||||
|
|
136
src/number.c
136
src/number.c
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue