開発環境
- macOS Sierra - Apple (OS)
- Emacs (Text Editor)
- C, Scheme (プログラミング言語)
- Clang/LLVM (コンパイラ, Xcode - Apple)
- 参考書籍等
Cを高級アセンブラーとした、Scheme の コンパイラー(ksc)、インタプリター(ksi)の作成で、標準ライブラリの complex ライブラリの手続きのを実装、複素数を扱うライブラリを complex(c11) から GNU MPC に変更。
コード
number.h
#pragma once /** \file */ #include "object.h" extern fn_obj_of_obj bool_of_obj_ks[]; extern fn_obj_of_obj obj_of_obj_obj_ks[]; extern fn_obj_of_obj obj_of_obj_ks[]; extern mpfr_prec_t prec; /* */ /* complex library */ Object number_angle(Object args); Object number_imag_part(Object args); Object number_magnitude(Object args); Object number_make_polar(Object args); Object number_make_rectangular(Object args); Object number_real_part(Object args); void number_init();
number.c
#include "number.h"
/* mpfr_prec_t prec = 53; */
mpfr_prec_t prec = 128;
/* */
/* complex library */
Object number_angle(Object args) {
return apply_obj_of_obj(number_angle, args);
}
Object number_imag_part(Object args) {
return apply_obj_of_obj(number_imag_part, args);
}
Object number_magnitude(Object args) {
return apply_obj_of_obj(number_magnitude, args);
}
Object number_make_polar(Object args) {
return apply_obj_of_obj_obj(number_make_polar, args);
}
Object number_make_rectangular(Object args) {
return apply_obj_of_obj_obj(number_make_rectangular, args);
}
Object number_real_part(Object args) {
return apply_obj_of_obj(number_real_part, args);
}
/* */
scm_complex.c
#include "scm_complex.h"
static mpf_t opf1, opf2;
Object complex_new(char const *real, char const *imag, int base) {
mpf_set_str(opf1, real, base);
mpf_set_str(opf2, imag, base);
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_f_f(out.z, opf1, opf2, MPC_RNDNN);
return out;
}
static Object copy(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set(out.z, o.z, MPC_RNDNN);
return out;
}
static void complex_free(Object *ptr) { mpc_clear(ptr->z); }
/* object.h */
static bool eqv_p(Object o1, Object o2) { return mpc_cmp(o1.z, o2.z) == 0; }
static mpfr_t opfr1, opfr2;
static void write(Object o, FILE *s) {
if (mpfr_inf_p(mpc_realref(o.z))) {
fprintf(s, "%cinf.0", mpfr_sgn(mpc_realref(o.z)) > 0 ? '+' : '-');
} else if (mpfr_nan_p(mpc_realref(o.z))) {
fprintf(s, "+nan.0");
} else {
mpfr_get_f(opf1, mpc_realref(o.z), MPFR_RNDN);
gmp_fprintf(s, "%.*Fg", prec, opf1);
mpfr_round(opfr1, mpc_realref(o.z));
if (mpfr_equal_p(opfr1, mpc_realref(o.z))) {
fprintf(s, ".0");
}
}
if (!mpfr_zero_p(mpc_imagref(o.z))) {
if (mpfr_inf_p(mpc_imagref(o.z))) {
fprintf(s, "%cinf.0", mpfr_sgn(mpc_imagref(o.z)) > 0 ? '+' : '-');
} else if (mpfr_nan_p(mpc_imagref(o.z))) {
fprintf(s, "+nan.0");
} else {
mpfr_get_f(opf1, mpc_imagref(o.z), MPFR_RNDN);
gmp_fprintf(s, "%+.*Fg", prec, opf1);
mpfr_round(opfr1, mpc_imagref(o.z));
if (mpfr_equal_p(opfr1, mpc_imagref(o.z))) {
fprintf(s, ".0");
}
}
fprintf(s, "i");
}
}
/* number.h */
static bool integer_p(Object o) {
if (mpfr_zero_p(mpc_imagref(o.z))) {
mpfr_round(opfr1, mpc_realref(o.z));
return mpfr_equal_p(opfr1, mpc_realref(o.z));
}
return false;
}
static bool exact_p(Object o) { return false; }
static bool finite_p(Object o) {
return !mpfr_inf_p(mpc_realref(o.z)) && !mpfr_inf_p(mpc_imagref(o.z)) &&
!mpfr_nan_p(mpc_realref(o.z)) && !mpfr_nan_p(mpc_imagref(o.z));
}
static bool infinite_p(Object o) {
return mpfr_inf_p(mpc_realref(o.z)) || mpfr_inf_p(mpc_imagref(o.z));
}
static bool nan_p(Object o) {
return mpfr_nan_p(mpc_realref(o.z)) || mpfr_nan_p(mpc_imagref(o.z));
}
static bool lt(Object o1, Object o2) {
return mpfr_less_p(mpc_realref(o1.z), mpc_realref(o2.z));
}
static Object math_equal(Object o1, Object o2) {
return mpc_cmp(o1.z, o2.z) == 0 ? boolean_true : boolean_false;
}
static Object add(Object o1, Object o2) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_add(out.z, o1.z, o2.z, MPC_RNDNN);
return out;
}
static Object mul(Object o1, Object o2) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_mul(out.z, o1.z, o2.z, MPC_RNDNN);
return out;
}
static Object sub(Object o1, Object o2) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_sub(out.z, o1.z, o2.z, MPC_RNDNN);
return out;
}
static Object complex_div(Object o1, Object o2) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_div(out.z, o1.z, o2.z, MPC_RNDNN);
return out;
}
static Object complex_floor(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpfr_floor(opfr1, mpc_realref(o.z));
mpc_set_fr(out.z, opfr1, MPC_RNDNN);
return out;
}
static Object ceiling(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpfr_ceil(opfr1, mpc_realref(o.z));
mpc_set_fr(out.z, opfr1, MPC_RNDNN);
return out;
}
static Object truncate(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpfr_trunc(opfr1, mpc_realref(o.z));
mpc_set_fr(out.z, opfr1, MPC_RNDNN);
return out;
}
static Object complex_round(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpfr_round(opfr1, mpc_realref(o.z));
mpc_set_fr(out.z, opfr1, MPC_RNDNN);
return out;
}
static Object complex_sqrt(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_sqrt(out.z, o.z, MPC_RNDNN);
return out;
}
static Object inexact(Object o) { return copy(o); }
static Object even_p(Object o) {
mpfr_div_ui(opfr1, mpc_realref(o.z), 2, MPFR_RNDN);
return mpfr_zero_p(opfr1) ? boolean_true : boolean_false;
}
static Object exact(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpfr_get_f(opf1, mpc_realref(o.z), MPFR_RNDN);
mpq_set_f(out.rational, opf1);
return out;
}
static Object expt(Object o1, Object o2) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_pow(out.z, o1.z, o2.z, MPC_RNDNN);
return out;
}
static Object to_char(Object o) {
return (Object){.type = CHAR, .ch = mpfr_get_ui(mpc_realref(o.z), MPFR_RNDN)};
}
static Object negative_p(Object o) {
return mpfr_sgn(mpc_realref(o.z)) < 0 ? boolean_true : boolean_false;
}
static Object odd_p(Object o) {
mpfr_div_ui(opfr1, mpc_realref(o.z), 2, MPFR_RNDN);
return mpfr_zero_p(opfr1) ? boolean_false : boolean_true;
}
static Object positive_p(Object o) {
return mpfr_sgn(mpc_realref(o.z)) > 0 ? boolean_true : boolean_false;
}
static Object square(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_pow_ui(out.z, o.z, 2, MPC_RNDNN);
return out;
}
static Object angle(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_arg(opfr1, o.z, MPFR_RNDN);
mpc_set_fr(out.z, opfr1, MPC_RNDNN);
return out;
}
static Object imag_part(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_fr(out.z, mpc_imagref(o.z), MPC_RNDNN);
return out;
}
static Object magnitude(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_abs(opfr1, o.z, MPFR_RNDN);
mpc_set_fr(out.z, opfr1, MPC_RNDNN);
return out;
}
static Object make_polar(Object o1, Object o2) {
mpfr_cos(opfr1, mpc_realref(o1.z), MPFR_RNDN);
mpfr_sin(opfr2, mpc_realref(o2.z), MPFR_RNDN);
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_fr_fr(out.z, opfr1, opfr2, MPC_RNDNN);
return out;
}
static Object make_rectangular(Object o1, Object o2) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_fr_fr(out.z, mpc_realref(o1.z), mpc_realref(o2.z), MPC_RNDNN);
return out;
}
static Object real_part(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_fr(out.z, mpc_realref(o.z), MPC_RNDNN);
return out;
}
void complex_init() {
fn_of_obj_ptr of_obj_ptr_ks[] = {object_free, NULL};
fn_of_obj_ptr of_obj_ptr_vs[] = {complex_free, NULL};
for (size_t i = 0; of_obj_ptr_ks[i] != NULL; i++) {
put_of_obj_ptr(of_obj_ptr_ks[i], COMPLEX, of_obj_ptr_vs[i]);
}
fn_obj_of_obj ks1[] = {object_eqv_p, object_eq_p, number_lt, NULL};
fn_bool_of_obj_obj vs1[] = {eqv_p, eqv_p, lt, NULL};
for (size_t i = 0; ks1[i] != NULL; i++) {
put_bool_of_obj_obj(ks1[i], COMPLEX, COMPLEX, vs1[i]);
}
fn_obj_of_obj of_obj_file_ks[] = {object_write, NULL};
fn_of_obj_file of_obj_file_vs[] = {write, NULL};
for (size_t i = 0; of_obj_file_ks[i] != NULL; i++) {
put_of_obj_file(of_obj_file_ks[i], COMPLEX, of_obj_file_vs[i]);
}
/* number.h */
fn_obj_of_obj bool_of_obj_ks[] = {object_integer_p, number_exact_p,
number_finite_p, number_infinite_p,
number_nan_p, NULL};
fn_bool_of_obj bool_of_obj_vs[] = {integer_p, exact_p, finite_p,
infinite_p, nan_p, NULL};
for (size_t i = 0; bool_of_obj_ks[i] != NULL; i++) {
put_bool_of_obj(bool_of_obj_ks[i], COMPLEX, bool_of_obj_vs[i]);
}
fn_obj_of_obj obj_of_obj_obj_ks[] = {number_math_equal,
number_add,
number_mul,
number_sub,
number_div,
number_expt,
number_make_polar,
number_make_rectangular,
NULL};
fn_obj_of_obj_obj obj_of_obj_obj_vs[] = {
math_equal, add, mul, sub, complex_div, expt, make_polar,
make_rectangular, NULL};
for (size_t i = 0; obj_of_obj_obj_ks[i] != NULL; i++) {
put_obj_of_obj_obj(obj_of_obj_obj_ks[i], COMPLEX, COMPLEX,
obj_of_obj_obj_vs[i]);
}
fn_obj_of_obj obj_of_obj_ks[] = {object_copy,
number_ceiling,
number_inexact,
number_even_p,
number_exact,
number_floor,
number_to_char,
number_negative_p,
number_odd_p,
number_positive_p,
number_round,
number_square,
number_truncate,
number_sqrt,
number_angle,
number_imag_part,
number_magnitude,
number_real_part,
NULL};
fn_obj_of_obj obj_of_obj_vs[] = {
copy, ceiling, inexact, even_p, exact,
complex_floor, to_char, negative_p, odd_p, positive_p,
complex_round, square, truncate, complex_sqrt, angle,
imag_part, magnitude, real_part, NULL};
for (size_t i = 0; obj_of_obj_ks[i] != NULL; i++) {
put_obj_of_obj(obj_of_obj_ks[i], COMPLEX, obj_of_obj_vs[i]);
}
mpf_inits(opf1, opf2, NULL);
mpfr_inits(opfr1, opfr2, NULL);
}
rational.c
#include "rational.h"
Object rational_new(char const *s, int base) {
Object o = {.type = RATIONAL};
mpq_init(o.rational);
mpq_set_str(o.rational, s, base);
mpq_canonicalize(o.rational);
return o;
}
static Object copy(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpq_set(out.rational, o.rational);
return out;
}
static void rational_free(Object *o_ptr) { mpq_clear(o_ptr->rational); }
static bool eqv_p(Object o1, Object o2) {
return mpq_equal(o1.rational, o2.rational);
}
static bool exact_p(Object o) { return true; }
static bool integer_p(Object o) {
return mpz_cmp_ui(mpq_denref(o.rational), 1) == 0;
}
static bool finite_p(Object o) { return true; }
static bool infinite_p(Object o) { return false; }
static bool nan_p(Object o) { return false; }
static Object math_equal(Object o1, Object o2) {
return mpq_equal(o1.rational, o2.rational) ? boolean_true : boolean_false;
}
static bool lt(Object o1, Object o2) {
return mpq_cmp(o1.rational, o2.rational) < 0 ? true : false;
}
static Object apply_void_mp_mp_mp(void (*fn)(mpq_ptr, mpq_srcptr, mpq_srcptr),
Object o1, Object o2) {
Object o = {.type = RATIONAL};
mpq_init(o.rational);
fn(o.rational, o1.rational, o2.rational);
return o;
}
static Object add(Object o1, Object o2) {
return apply_void_mp_mp_mp(mpq_add, o1, o2);
}
static Object mul(Object o1, Object o2) {
return apply_void_mp_mp_mp(mpq_mul, o1, o2);
}
static Object sub(Object o1, Object o2) {
return apply_void_mp_mp_mp(mpq_sub, o1, o2);
}
static Object rational_div(Object o1, Object o2) {
return apply_void_mp_mp_mp(mpq_div, o1, o2);
}
static Object numerator(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpq_set_z(out.rational, mpq_numref(o.rational));
return out;
}
static Object denominator(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpq_set_z(out.rational, mpq_denref(o.rational));
return out;
}
static Object rational_floor(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpz_fdiv_q(mpq_numref(out.rational), mpq_numref(o.rational),
mpq_denref(o.rational));
mpz_set_ui(mpq_denref(out.rational), 1);
return out;
}
static Object ceiling(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpz_cdiv_q(mpq_numref(out.rational), mpq_numref(o.rational),
mpq_denref(o.rational));
mpz_set_ui(mpq_denref(out.rational), 1);
return out;
}
static Object truncate(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpz_tdiv_q(mpq_numref(out.rational), mpq_numref(o.rational),
mpq_denref(o.rational));
mpz_set_ui(mpq_denref(out.rational), 1);
return out;
}
static Object to_complex(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_q(out.z, o.rational, MPC_RNDNN);
return out;
}
static Object inexact(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_q(out.z, o.rational, MPC_RNDNN);
return out;
}
static Object rational_sqrt(Object o) {
if (mpz_perfect_square_p(mpq_numref(o.rational)) &&
mpz_perfect_square_p(mpq_denref(o.rational))) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpz_sqrt(mpq_numref(out.rational), mpq_numref(o.rational));
mpz_sqrt(mpq_denref(out.rational), mpq_denref(o.rational));
return out;
}
Object o0 = to_complex(o);
fn_obj_of_obj fn = get_obj_of_obj(number_sqrt, o0);
Object out = fn(o0);
rational_free(&o0);
return out;
}
static void write(Object o, FILE *port) { mpq_out_str(port, 10, o.rational); }
static Object even_p(Object o) {
return mpz_even_p(mpq_numref(o.rational)) ? boolean_true : boolean_false;
}
static Object exact(Object o) { return copy(o); }
static mpc_t opc1, opc2;
static Object expt(Object o1, Object o2) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
mpc_set_q(opc1, o1.rational, MPC_RNDNN);
mpc_set_q(opc2, o1.rational, MPC_RNDNN);
mpc_pow(out.z, opc1, opc2, MPC_RNDNN);
return out;
}
static Object gcd(Object o1, Object o2) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpz_gcd(mpq_numref(out.rational), mpq_numref(o1.rational),
mpq_numref(o2.rational));
mpz_set_ui(mpq_denref(out.rational), 1);
return out;
}
static Object to_char(Object o) {
return (Object){.type = CHAR, .ch = mpz_get_ui(mpq_numref(o.rational))};
}
static Object lcm(Object o1, Object o2) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpz_lcm(mpq_numref(out.rational), mpq_numref(o1.rational),
mpq_numref(o2.rational));
mpz_set_ui(mpq_denref(out.rational), 1);
return out;
}
static Object negative_p(Object o) {
return mpq_sgn(o.rational) == -1 ? boolean_true : boolean_false;
}
static Object odd_p(Object o) {
return mpz_odd_p(mpq_numref(o.rational)) ? boolean_true : boolean_false;
}
static Object positive_p(Object o) {
return mpq_sgn(o.rational) == 1 ? boolean_true : boolean_false;
}
static mpfr_t opfr1;
static Object rational_round(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpfr_set_q(opfr1, o.rational, MPFR_RNDN);
mpfr_get_z(mpq_numref(out.rational), opfr1, MPFR_RNDN);
mpz_set_ui(mpq_denref(out.rational), 1);
return out;
}
static Object square(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpq_mul(out.rational, o.rational, o.rational);
return out;
}
static Object angle(Object o) {
Object out = {.type = COMPLEX};
mpc_init2(out.z, prec);
if (mpq_sgn(o.rational) >= 0) {
mpc_set_ui(out.z, 0, MPC_RNDNN);
} else {
mpfr_const_pi(opfr1, MPFR_RNDN);
mpc_set_fr(out.z, opfr1, MPC_RNDNN);
}
return out;
}
static Object imag_part(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpq_set_ui(out.rational, 0, 1);
return out;
}
static Object magnitude(Object o) {
Object out = {.type = RATIONAL};
mpq_init(out.rational);
mpq_abs(out.rational, o.rational);
return out;
}
static Object real_part(Object o) { return copy(o); }
void rational_init() {
fn_obj_of_obj ks1[] = {object_eqv_p, object_eq_p, number_lt, NULL};
fn_bool_of_obj_obj vs1[] = {eqv_p, eqv_p, lt, NULL};
for (size_t i = 0; ks1[i] != NULL; i++) {
put_bool_of_obj_obj(ks1[i], RATIONAL, RATIONAL, vs1[i]);
}
fn_obj_of_obj bool_of_obj_ks[] = {object_integer_p, number_exact_p,
number_finite_p, number_infinite_p,
number_nan_p, NULL};
fn_bool_of_obj bool_of_obj_vs[] = {integer_p, exact_p, finite_p,
infinite_p, nan_p, NULL};
for (size_t i = 0; bool_of_obj_ks[i] != NULL; i++) {
put_bool_of_obj(bool_of_obj_ks[i], RATIONAL, bool_of_obj_vs[i]);
}
fn_obj_of_obj obj_of_obj_obj_ks[] = {
number_math_equal, number_add, number_mul, number_sub, number_div,
number_expt, number_gcd, number_lcm, NULL};
fn_obj_of_obj_obj obj_of_obj_obj_vs[] = {
math_equal, add, mul, sub, rational_div, expt, gcd, lcm, NULL};
for (size_t i = 0; obj_of_obj_obj_ks[i] != NULL; i++) {
put_obj_of_obj_obj(obj_of_obj_obj_ks[i], RATIONAL, RATIONAL,
obj_of_obj_obj_vs[i]);
}
fn_obj_of_obj of_obj_file_ks[] = {object_write, NULL};
fn_of_obj_file of_obj_file_vs[] = {write, NULL};
for (size_t i = 0; of_obj_file_ks[i] != NULL; i++) {
put_of_obj_file(of_obj_file_ks[i], RATIONAL, of_obj_file_vs[i]);
}
fn_obj_of_obj obj_of_obj_ks[] = {
object_copy, number_denominator, number_ceiling,
number_sqrt, number_inexact, number_even_p,
number_exact, number_floor, number_to_char,
number_negative_p, number_numerator, number_odd_p,
number_positive_p, number_round, number_square,
number_truncate, number_angle, number_imag_part,
number_magnitude, number_real_part, NULL};
fn_obj_of_obj obj_of_obj_vs[] = {
copy, denominator, ceiling, rational_sqrt, inexact, even_p,
exact, rational_floor, to_char, negative_p, numerator, odd_p,
positive_p, rational_round, square, truncate, angle, imag_part,
magnitude, real_part, NULL};
for (size_t i = 0; obj_of_obj_ks[i] != NULL; i++) {
put_obj_of_obj(obj_of_obj_ks[i], RATIONAL, obj_of_obj_vs[i]);
}
fn_of_obj_ptr of_obj_ptr_ks[] = {object_free, NULL};
fn_of_obj_ptr of_obj_ptr_vs[] = {rational_free, NULL};
for (size_t i = 0; of_obj_ptr_ks[i] != NULL; i++) {
put_of_obj_ptr(of_obj_ptr_ks[i], RATIONAL, of_obj_ptr_vs[i]);
}
mpfr_init(opfr1);
mpc_init2(opc1, prec);
mpc_init2(opc2, prec);
}
ksi.scm
(begin
;;
(define (primitive-procedure? proc) (tagged-list? proc 'primitive))
(define (primitive-implementation proc) (car (cdr proc)))
(load "./lib/stdlib/base/primitive_procedures.scm")
(load "./lib/stdlib/char/primitive_procedures.scm")
(load "./lib/stdlib/complex/primitive_procedures.scm")
(define primitive-procedures
(list ;; complex
(c-cons 'angle angle)
(c-cons 'imag-part imag-part)
(c-cons 'magnitude magnitude)
(c-cons 'make-polar make-polar)
(c-cons 'make-rectangular make-rectangular)
(c-cons 'real-part real-part)
))
;;
)
lib/stdlib/complex/primitive_procedures.scm
(begin
(define (angle . args)
(if (c-= (c-length args) 1)
(if (c-number? (c-car args))
(c-angle (c-car args))
(error '|(angle) wrong type of argument --| args))
(error '|(angle) wrong number of arguments --| args)))
(define (imag-part . args)
(if (c-= (c-length args) 1)
(if (c-number? (c-car args))
(c-imag-part (c-car args))
(error '|(imag-part) wrong type of argument --| args))
(error '|(imag-part) wrong number of arguments --| args)))
(define (magnitude . args)
(if (c-= (c-length args) 1)
(if (c-number? (c-car args))
(c-magnitude (c-car args))
(error '|(magnitude) wrong type of argument --| args))
(error '|(magnitude) wrong number of arguments --| args)))
(define (make-polar . args)
(if (c-= (c-length args) 2)
(begin
(define x1 (c-car args))
(define x2 (c-cadr args))
(if (and (c-real? x1) (c-real? x2))
(c-make-polar (c-inexact x1) (c-inexact x2))
(error '|(make-polar) wrong type of argument --| args)))
(error '|(make-polar) wrong number of arguments --| args)))
(define (make-rectangular . args)
(if (c-= (c-length args) 2)
(begin
(define x1 (c-car args))
(define x2 (c-cadr args))
(if (and (c-real? x1) (c-real? x2))
(c-make-rectangular (c-inexact x1) (c-inexact x2))
(error '|(make-rectangular) wrong type of argument --| args)))
(error '|(make-rectangular) wrong number of arguments --| args)))
(define (real-part . args)
(if (c-= (c-length args) 1)
(if (c-number? (c-car args))
(c-real-part (c-car args))
(error '|(real-part) wrong type of argument --| args))
(error '|(real-part) wrong number of arguments --| args)))
)
0 コメント:
コメントを投稿