suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

misc accumulated mzscheme tweaks

Browse Source 
svn: r11318
This commit is contained in:
Matthew Flatt 2008-08-19 02:30:20 +00:00
parent 76cf25fc12
commit 85405bc80b
7 changed files with 41 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/mzscheme/src/fun.c
View File

@ -956,6 +956,8 @@ scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info)
info = scheme_optimize_info_add_frame(info, data->num_params, data->num_params,
SCHEME_LAMBDA_FRAME);
/* For reporting warnings: */
if (info->context && SCHEME_PAIRP(info->context))
ctx = scheme_make_pair((Scheme_Object *)data,
SCHEME_CDR(info->context));

12
src/mzscheme/src/numarith.c
View File

@ -249,10 +249,14 @@ static Scheme_Object *unary_minus(const Scheme_Object *n)
return minus(1, a);
}
GEN_BIN_OP(scheme_bin_plus, "+", ADD, F_ADD, FS_ADD, scheme_bignum_add, scheme_rational_add, scheme_complex_add, GEN_RETURN_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK)
GEN_BIN_OP(scheme_bin_minus, "-", SUBTRACT, F_SUBTRACT, FS_SUBTRACT, scheme_bignum_subtract, scheme_rational_subtract, scheme_complex_subtract, GEN_SINGLE_SUBTRACT_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK)
GEN_BIN_OP(scheme_bin_mult, "*", MULTIPLY, F_MULTIPLY, FS_MULTIPLY, scheme_bignum_multiply, scheme_rational_multiply, scheme_complex_multiply, GEN_RETURN_0, GEN_RETURN_0, NO_NAN_CHECK, NO_NAN_CHECK)
GEN_BIN_DIV_OP(scheme_bin_div, "/", DIVIDE, F_DIVIDE, FS_DIVIDE, scheme_make_rational, scheme_rational_divide, scheme_complex_divide)
#define ret_other(n1, n2) if (SAME_OBJ(n1, scheme_make_integer(0))) return (Scheme_Object *)n2
#define ret_1other(n1, n2) if (SAME_OBJ(n1, scheme_make_integer(1))) return (Scheme_Object *)n2
#define ret_zero(n1, n2) if (SAME_OBJ(n1, scheme_make_integer(0))) return scheme_make_integer(0)
GEN_BIN_OP(scheme_bin_plus, "+", ADD, F_ADD, FS_ADD, scheme_bignum_add, scheme_rational_add, scheme_complex_add, GEN_RETURN_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK, ret_other, cx_NO_CHECK, ret_other, cx_NO_CHECK)
GEN_BIN_OP(scheme_bin_minus, "-", SUBTRACT, F_SUBTRACT, FS_SUBTRACT, scheme_bignum_subtract, scheme_rational_subtract, scheme_complex_subtract, GEN_SINGLE_SUBTRACT_N2, GEN_RETURN_N1, NO_NAN_CHECK, NO_NAN_CHECK, cx_NO_CHECK, cx_NO_CHECK, ret_other, cx_NO_CHECK)
GEN_BIN_OP(scheme_bin_mult, "*", MULTIPLY, F_MULTIPLY, FS_MULTIPLY, scheme_bignum_multiply, scheme_rational_multiply, scheme_complex_multiply, GEN_RETURN_0, GEN_RETURN_0, NO_NAN_CHECK, NO_NAN_CHECK, ret_zero, ret_1other, ret_zero, ret_1other)
GEN_BIN_DIV_OP(scheme_bin_div, "/", DIVIDE, F_DIVIDE, FS_DIVIDE, scheme_make_rational, scheme_rational_divide, scheme_complex_divide, ret_zero, cx_NO_CHECK, cx_NO_CHECK, ret_1other)
GEN_NARY_OP(static, plus, "+", scheme_bin_plus, 0, SCHEME_NUMBERP, "number", GEN_IDENT)
GEN_NARY_OP(static, mult, "*", scheme_bin_mult, 1, SCHEME_NUMBERP, "number", GEN_IDENT)

2
src/mzscheme/src/number.c
View File

@ -1960,7 +1960,7 @@ GEN_BIN_PROT(bin_expt);
scheme_real_to_complex(scheme_make_float(y))) \
: scheme_make_float(sch_pow((double)x, (double)y)))
static GEN_BIN_OP(bin_expt, "expt", fixnum_expt, F_EXPT, FS_EXPT, scheme_generic_integer_power, scheme_rational_power, scheme_complex_power, GEN_RETURN_0_USUALLY, GEN_RETURN_1, NAN_RETURNS_NAN, NAN_RETURNS_SNAN)
static GEN_BIN_OP(bin_expt, "expt", fixnum_expt, F_EXPT, FS_EXPT, scheme_generic_integer_power, scheme_rational_power, scheme_complex_power, GEN_RETURN_0_USUALLY, GEN_RETURN_1, NAN_RETURNS_NAN, NAN_RETURNS_SNAN, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK)
Scheme_Object *
scheme_expt(int argc, Scheme_Object *argv[])

4
src/mzscheme/src/numcomp.c
View File

@ -289,8 +289,8 @@ negative_p (int argc, Scheme_Object *argv[])
#define MAX_IZI(a, b) bin_max(IZI_REAL_PART(a), IZI_REAL_PART(b))
#define MIN_IZI(a, b) bin_min(IZI_REAL_PART(a), IZI_REAL_PART(b))
static GEN_BIN_OP(bin_max, "max", MAX, F_MAX, FS_MAX, scheme_bignum_max, scheme_rational_max, MAX_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN)
static GEN_BIN_OP(bin_min, "min", MIN, F_MIN, FS_MIN, scheme_bignum_min, scheme_rational_min, MIN_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN)
static GEN_BIN_OP(bin_max, "max", MAX, F_MAX, FS_MAX, scheme_bignum_max, scheme_rational_max, MAX_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK)
static GEN_BIN_OP(bin_min, "min", MIN, F_MIN, FS_MIN, scheme_bignum_min, scheme_rational_min, MIN_IZI, GEN_OMIT, GEN_OMIT, NAN_RETURNS_NAN, NAN_RETURNS_SNAN, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK)
GEN_TWOARY_OP(static, sch_max, "max", bin_max, SCHEME_REALP, REAL_NUMBER_STR)
GEN_TWOARY_OP(static, sch_min, "min", bin_min, SCHEME_REALP, REAL_NUMBER_STR)

30
src/mzscheme/src/nummacs.h
View File

@ -97,6 +97,8 @@ name (int argc, Scheme_Object *argv[]) \
#define GEN_BIN_PROT(name) \
static Scheme_Object *name (const Scheme_Object *n1, const Scheme_Object *n2)
#define cx_NO_CHECK(n1, n2) /* empty */
/* This macro is used to implement most all binary math and comparison functions (!): */
#define GEN_BIN_THING(rettype, name, scheme_name, \
iop, fop, fsop, bn_op, rop, cxop, \
@ -106,7 +108,8 @@ static Scheme_Object *name (const Scheme_Object *n1, const Scheme_Object *n2)
combinezero, firstzero, sfirstzero, secondzero, ssecondzero, \
nanchk, snanchk, nanchk_more, snanchk_more, \
complexwrap, noniziwrap, exactzerowrapl, exactzerowrapr, numbertype,\
toi_or_toe) \
toi_or_toe, \
check_exact_zero1, check_exact_one1, check_exact_zero2, check_exact_one2) \
rettype name (const Scheme_Object *n1, const Scheme_Object *n2); \
static rettype name ## __wrong_type(const Scheme_Object *v) \
{ \
@ -117,12 +120,16 @@ static rettype name ## __wrong_type(const Scheme_Object *v) \
} \
static MZ_INLINE rettype name ## __int_big(const Scheme_Object *n1, const Scheme_Object *n2) { \
Small_Bignum sb; \
check_exact_zero1(n1, n2); \
check_exact_one1(n1, n2); \
return bn_op((scheme_make_small_bignum(SCHEME_INT_VAL(n1), \
&sb)), \
(n2)); \
} \
static MZ_INLINE rettype name ## __int_rat(const Scheme_Object *n1, const Scheme_Object *n2) { \
Small_Rational sr1; \
check_exact_zero1(n1, n2); \
check_exact_one1(n1, n2); \
return rop((scheme_make_small_rational(SCHEME_INT_VAL(n1), \
&sr1)), \
(n2)); \
@ -130,6 +137,8 @@ static MZ_INLINE rettype name ## __int_rat(const Scheme_Object *n1, const Scheme
complexwrap( \
static MZ_INLINE rettype name ## __int_comp(const Scheme_Object *n1, const Scheme_Object *n2) { \
Small_Complex sc; \
check_exact_zero1(n1, n2); \
check_exact_one1(n1, n2); \
return cxop((scheme_make_small_complex(n1, &sc)), \
(n2)); \
}) \
@ -185,6 +194,8 @@ static MZ_INLINE rettype name ## __dbl_comp(double d1, const Scheme_Object *n1,
}) \
static MZ_INLINE rettype name ## __big_int(const Scheme_Object *n1, const Scheme_Object *n2) { \
Small_Bignum sb; \
check_exact_zero2(n2, n1); \
check_exact_one2(n2, n1); \
return bn_op((n1), (scheme_make_small_bignum(SCHEME_INT_VAL(n2), &sb))); \
} \
FLOATWRAP( \
@ -217,6 +228,8 @@ static MZ_INLINE rettype name ## __big_comp(const Scheme_Object *n1, const Schem
} \
static MZ_INLINE rettype name ## __rat_int(const Scheme_Object *n1, const Scheme_Object *n2) { \
Small_Rational sr8; \
check_exact_zero2(n2, n1); \
check_exact_one2(n2, n1); \
return rop((n1), \
(scheme_make_small_rational(SCHEME_INT_VAL(n2), \
&sr8))); \
@ -255,6 +268,8 @@ static MZ_INLINE rettype name ## __rat_comp(const Scheme_Object *n1, const Schem
complexwrap( \
static MZ_INLINE rettype name ## __comp_int(const Scheme_Object *n1, const Scheme_Object *n2) { \
Small_Complex sc; \
check_exact_zero2(n2, n1); \
check_exact_one2(n2, n1); \
return cxop((n1), (scheme_make_small_complex(n2, &sc))); \
}) \
FLOATWRAP(complexwrap( \
@ -517,7 +532,7 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
# define NAN_CHECK_0(x) if (MZ_IS_NAN(x)) return 0
#define GEN_BIN_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop, exzeopl, exzeopr, nanckop, snanckop) \
#define GEN_BIN_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop, exzeopl, exzeopr, nanckop, snanckop, c0_1, c1_1, c0_2, c1_2) \
GEN_BIN_THING(Scheme_Object *, name, scheme_name, \
iop, fop, fsop, bn_op, rop, cxop, \
GEN_OMIT, GEN_FIRST_ONLY, \
@ -525,9 +540,10 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
0, 0, 0, 0, \
GEN_SCHEME_BOOL_APPLY, badfunc, badfunc, badfunc, badfunc, \
nanckop, snanckop, nanckop, snanckop, \
GEN_IDENT, GEN_IDENT, exzeopl, exzeopr, "number", GEN_TOI)
GEN_IDENT, GEN_IDENT, exzeopl, exzeopr, "number", GEN_TOI, \
c0_1, c1_1, c0_2, c1_2)
#define GEN_BIN_DIV_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop) \
#define GEN_BIN_DIV_OP(name, scheme_name, iop, fop, fsop, bn_op, rop, cxop, c0_1, c1_1, c0_2, c1_2) \
GEN_BIN_THING(Scheme_Object *, name, scheme_name, \
iop, fop, fsop, bn_op, rop, cxop, \
GEN_IDENT, GEN_APPLY, \
@ -535,7 +551,8 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
GEN_MAKE_NZERO, GEN_MAKE_NSZERO, GEN_MAKE_PZERO, GEN_MAKE_PSZERO, \
GEN_APPLY3, GEN_MAKE_ZERO_Z, GEN_MAKE_SZERO_Z, GEN_SAME_INF_Z, GEN_SAME_SINF_Z, \
NAN_CHECK_NAN_IF_WEIRD, SNAN_CHECK_NAN_IF_WEIRD, NAN_CHECK_NAN_IF_WEIRD, SNAN_CHECK_NAN_IF_WEIRD, \
GEN_IDENT, GEN_IDENT, GEN_RETURN_0, GEN_OMIT, "number", GEN_TOI)
GEN_IDENT, GEN_IDENT, GEN_RETURN_0, GEN_OMIT, "number", GEN_TOI, \
c0_1, c1_1, c0_2, c1_2)
#define GEN_BIN_COMP(name, scheme_name, iop, fop, bn_op, rop, cxop, waybig, waysmall, firstzero, secondzero, complexwrap, noniziwrap, numbertype) \
GEN_BIN_THING(int, name, scheme_name, \
@ -545,7 +562,8 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
waybig, waybig, waysmall, waysmall, \
GEN_SCHEME_BOOL_APPLY, firstzero, firstzero, secondzero, secondzero, \
NAN_CHECK_0_IF_WEIRD, NAN_CHECK_0_IF_WEIRD, NAN_CHECK_0, NAN_CHECK_0, \
complexwrap, noniziwrap, GEN_OMIT, GEN_OMIT, numbertype, GEN_TOE)
complexwrap, noniziwrap, GEN_OMIT, GEN_OMIT, numbertype, GEN_TOE, \
cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK, cx_NO_CHECK)
#define GEN_BIN_INT_OP(name, scheme_name, op, bigop) \
static Scheme_Object *name (const Scheme_Object *n1, const Scheme_Object *n2); \

6
src/mzscheme/src/read.c
View File

@ -5532,15 +5532,15 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in
scheme_end_atomic_no_swap();
if (v) {
delay_info->symtab[which] = v;
if (*ht) {
v = resolve_references(v, port, NULL,
scheme_make_hash_table(SCHEME_hash_ptr),
scheme_make_hash_table(SCHEME_hash_ptr),
0, 0);
}
delay_info->symtab[which] = v;
return v;
} else {
scheme_longjmp(*scheme_current_thread->error_buf, 1);

2
src/mzscheme/src/syntax.c
View File

@ -3321,7 +3321,7 @@ static int is_closed_reference(Scheme_Object *v)
{
/* Look for a converted function (possibly with no new arguments)
that is accessed directly as a closure, instead of through a
top-level reference. */
top-level reference. */
if (SCHEME_RPAIRP(v)) {
v = SCHEME_CAR(v);
return SCHEME_PROCP(v);