Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-09 14:07:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Replacing exact, inexact opcodes with primitive functions.

Browse source
This commit is contained in:
Alex Shinn 2013-09-08 17:48:38 +09:00
parent d32cc99cc1
commit fd9e9b5bf1
5 changed files with 74 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

71
eval.c
View file

@ -1584,6 +1584,77 @@ sexp sexp_complex_imag_op (sexp ctx, sexp self, sexp_sint_t n, sexp cpx) {
}
#endif
sexp sexp_exact_to_inexact (sexp ctx, sexp self, sexp_sint_t n, sexp i) {
sexp_gc_var1(res);
res = i;
if (sexp_fixnump(i))
res = sexp_fixnum_to_flonum(ctx, i);
#if SEXP_USE_FLONUMS
else if (sexp_flonump(i))
res = i;
#endif
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(i))
res = sexp_make_flonum(ctx, sexp_bignum_to_double(i));
#endif
#if SEXP_USE_RATIOS
else if (sexp_ratiop(i))
res = sexp_make_flonum(ctx, sexp_ratio_to_double(i));
#endif
#if SEXP_USE_COMPLEX
else if (sexp_complexp(i)) {
sexp_gc_preserve1(ctx, res);
res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO);
sexp_complex_real(res) = sexp_exact_to_inexact(ctx, self, 1, sexp_complex_real(i));
sexp_complex_imag(res) = sexp_exact_to_inexact(ctx, self, 1, sexp_complex_imag(i));
sexp_gc_release1(ctx);
}
#endif
else
res = sexp_type_exception(ctx, self, SEXP_FIXNUM, i);
return res;
}
sexp sexp_inexact_to_exact (sexp ctx, sexp self, sexp_sint_t n, sexp z) {
sexp_gc_var1(res);
if (sexp_exactp(z)) {
res = z;
}
#if SEXP_USE_FLONUMS
else if (sexp_flonump(z)) {
if (isinf(sexp_flonum_value(z)) || isnan(sexp_flonum_value(z))) {
res = sexp_xtype_exception(ctx, self, "exact: not an finite number", z);
} else if (sexp_flonum_value(z) != trunc(sexp_flonum_value(z))) {
#if SEXP_USE_RATIOS
res = sexp_double_to_ratio(ctx, sexp_flonum_value(z));
#else
res = sexp_xtype_exception(ctx, self, "exact: not an integer", z);
#endif
#if SEXP_USE_BIGNUMS
} else if ((sexp_flonum_value(z) > SEXP_MAX_FIXNUM)
|| sexp_flonum_value(z) < SEXP_MIN_FIXNUM) {
res = sexp_double_to_bignum(ctx, sexp_flonum_value(z));
#endif
} else {
res = sexp_make_fixnum((sexp_sint_t)sexp_flonum_value(z));
}
}
#endif
#if SEXP_USE_COMPLEX
else if (sexp_complexp(z)) {
sexp_gc_preserve1(ctx, res);
res = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO);
sexp_complex_real(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_real(z));
sexp_complex_imag(res) = sexp_inexact_to_exact(ctx, self, 1, sexp_complex_imag(z));
sexp_gc_release1(ctx);
}
#endif
else {
res = sexp_type_exception(ctx, self, SEXP_FLONUM, z);
}
return res;
}
sexp sexp_string_cmp_op (sexp ctx, sexp self, sexp_sint_t n, sexp str1, sexp str2, sexp ci) {
sexp_sint_t len1, len2, len, diff;
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str1);

4
include/chibi/eval.h
View file

@ -168,14 +168,14 @@ SEXP_API sexp sexp_floor(sexp ctx, sexp self, sexp_sint_t n, sexp x);
SEXP_API sexp sexp_ceiling(sexp ctx, sexp self, sexp_sint_t n, sexp x);
#endif
SEXP_API sexp sexp_expt_op(sexp ctx, sexp self, sexp_sint_t n, sexp z1, sexp z2);
SEXP_API sexp sexp_exact_to_inexact(sexp ctx, sexp self, sexp_sint_t n, sexp i);
SEXP_API sexp sexp_inexact_to_exact(sexp ctx, sexp self, sexp_sint_t n, sexp x);
#if SEXP_USE_NATIVE_X86
SEXP_API sexp sexp_write_char_op(sexp ctx, sexp self, sexp_sint_t n, sexp ch, sexp out);
SEXP_API sexp sexp_newline_op(sexp ctx, sexp self, sexp_sint_t n, sexp out);
SEXP_API sexp sexp_read_char_op(sexp ctx, sexp self, sexp_sint_t n, sexp in);
SEXP_API sexp sexp_peek_char_op(sexp ctx, sexp self, sexp_sint_t n, sexp in);
SEXP_API sexp sexp_exact_to_inexact(sexp ctx, sexp self, sexp_sint_t n, sexp i);
SEXP_API sexp sexp_inexact_to_exact(sexp ctx, sexp self, sexp_sint_t n, sexp x);
SEXP_API sexp sexp_char_upcase(sexp ctx, sexp self, sexp_sint_t n, sexp ch);
SEXP_API sexp sexp_char_downcase(sexp ctx, sexp self, sexp_sint_t n, sexp ch);
#endif

2
include/chibi/sexp.h
View file

@ -1607,8 +1607,6 @@ enum sexp_opcode_names {
SEXP_OP_LE,
SEXP_OP_EQN,
SEXP_OP_EQ,
SEXP_OP_FIX2FLO,
SEXP_OP_FLO2FIX,
SEXP_OP_CHAR2INT,
SEXP_OP_INT2CHAR,
SEXP_OP_CHAR_UPCASE,

4
opcodes.c
View file

@ -67,14 +67,12 @@ _OP(SEXP_OPC_SETTER, SEXP_OP_STRING_SET, 3, 0, SEXP_VOID, _I(SEXP_STRING), _I(SE
#endif
#endif
_OP(SEXP_OPC_GETTER, SEXP_OP_STRING_LENGTH, 1, 0, _I(SEXP_FIXNUM), _I(SEXP_STRING), SEXP_FALSE, SEXP_FALSE, 0,"string-length", 0, NULL),
#if SEXP_USE_NATIVE_X86
_FN1(_I(SEXP_FLONUM), _I(SEXP_FIXNUM), "exact->inexact", 0, sexp_exact_to_inexact),
_FN1(_I(SEXP_FIXNUM), _I(SEXP_FLONUM), "inexact->exact", 0, sexp_inexact_to_exact),
#if SEXP_USE_NATIVE_X86
_FN1(_I(SEXP_CHAR), _I(SEXP_CHAR), "char-upcase", 0, sexp_char_upcase),
_FN1(_I(SEXP_CHAR), _I(SEXP_CHAR), "char-downcase", 0, sexp_char_downcase),
#else
_OP(SEXP_OPC_GENERIC, SEXP_OP_FIX2FLO, 1, 0, _I(SEXP_FLONUM), _I(SEXP_NUMBER), SEXP_FALSE, SEXP_FALSE, 0, "exact->inexact", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_FLO2FIX, 1, 0, _I(SEXP_FIXNUM), _I(SEXP_NUMBER), SEXP_FALSE, SEXP_FALSE, 0, "inexact->exact", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_UPCASE, 1, 0, _I(SEXP_CHAR), _I(SEXP_CHAR), SEXP_FALSE, SEXP_FALSE, 0, "char-upcase", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_DOWNCASE, 1, 0, _I(SEXP_CHAR), _I(SEXP_CHAR), SEXP_FALSE, SEXP_FALSE, 0, "char-downcase", 0, NULL),
#endif

42
vm.c
View file

@ -1857,48 +1857,6 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
_ARG2 = sexp_make_boolean(_ARG1 == _ARG2);
top--;
break;
case SEXP_OP_FIX2FLO:
#if SEXP_USE_FLONUMS
sexp_context_top(ctx) = top;
if (sexp_fixnump(_ARG1))
_ARG1 = sexp_fixnum_to_flonum(ctx, _ARG1);
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(_ARG1))
_ARG1 = sexp_make_flonum(ctx, sexp_bignum_to_double(_ARG1));
#endif
#if SEXP_USE_RATIOS
else if (sexp_ratiop(_ARG1))
_ARG1 = sexp_make_flonum(ctx, sexp_ratio_to_double(_ARG1));
#endif
else if (! sexp_flonump(_ARG1))
sexp_raise("inexact: not a number", sexp_list1(ctx, _ARG1));
#endif
break;
case SEXP_OP_FLO2FIX:
#if SEXP_USE_FLONUMS
if (sexp_flonump(_ARG1)) {
if (isinf(sexp_flonum_value(_ARG1)) || isnan(sexp_flonum_value(_ARG1))) {
sexp_raise("exact: not an finite number", sexp_list1(ctx, _ARG1));
} else if (sexp_flonum_value(_ARG1) != trunc(sexp_flonum_value(_ARG1))) {
#if SEXP_USE_RATIOS
_ARG1 = sexp_double_to_ratio(ctx, sexp_flonum_value(_ARG1));
#else
sexp_raise("exact: not an integer", sexp_list1(ctx, _ARG1));
#endif
#if SEXP_USE_BIGNUMS
} else if ((sexp_flonum_value(_ARG1) > SEXP_MAX_FIXNUM)
|| sexp_flonum_value(_ARG1) < SEXP_MIN_FIXNUM) {
sexp_context_top(ctx) = top;
_ARG1 = sexp_double_to_bignum(ctx, sexp_flonum_value(_ARG1));
#endif
} else {
_ARG1 = sexp_make_fixnum((sexp_sint_t)sexp_flonum_value(_ARG1));
}
} else if (!sexp_exactp(_ARG1)) {
sexp_raise("exact: not a number", sexp_list1(ctx, _ARG1));
}
#endif
break;
case SEXP_OP_CHAR2INT:
if (! sexp_charp(_ARG1))
sexp_raise("char->integer: not a character", sexp_list1(ctx, _ARG1));