Scheme_Object *scheme_complex_normalize(const Scheme_Object *o)
{
Scheme_Complex *c = (Scheme_Complex *)o;
if (c->i == zero)
return c->r;
if (c->r == zero) {
/* No coercions */
return (Scheme_Object *)c;
}
/* Coercions: Exact -> float -> double
If the complex contains a float and an exact, we coerce the exact
to a float, etc. */
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(c->i)) {
if (!SCHEME_FLTP(c->r)) {
Scheme_Object *v;
if (SCHEME_DBLP(c->r)) {
v = scheme_make_double(SCHEME_FLT_VAL(c->i));
c->i = v;
} else {
v = scheme_make_float(scheme_get_val_as_float(c->r));
c->r = v;
}
}
} else if (SCHEME_FLTP(c->r)) {
Scheme_Object *v;
/* Imag part can't be a float, or we'd be in the previous case */
if (SCHEME_DBLP(c->i)) {
v = scheme_make_double(SCHEME_FLT_VAL(c->r));
c->r = v;
} else {
v = scheme_make_float(scheme_get_val_as_float(c->i));
c->i = v;
}
} else
#endif
if (SCHEME_DBLP(c->i)) {
if (!SCHEME_DBLP(c->r)) {
Scheme_Object *r;
r = scheme_make_double(scheme_get_val_as_double(c->r));
c->r = r;
}
} else if (SCHEME_DBLP(c->r)) {
Scheme_Object *i;
i = scheme_make_double(scheme_get_val_as_double(c->i));
c->i = i;
}
return (Scheme_Object *)c;
}
Scheme_Object *
scheme_abs(int argc, Scheme_Object *argv[])
{
Scheme_Type t;
Scheme_Object *o;
o = argv[0];
if (SCHEME_INTP(o)) {
intptr_t n = SCHEME_INT_VAL(o);
return scheme_make_integer_value(ABS(n));
}
t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
if (t == scheme_float_type)
return scheme_make_float(fabs(SCHEME_FLT_VAL(o)));
#endif
if (t == scheme_double_type)
return scheme_make_double(fabs(SCHEME_DBL_VAL(o)));
if (t == scheme_bignum_type) {
if (SCHEME_BIGPOS(o))
return o;
return scheme_bignum_negate(o);
}
if (t == scheme_rational_type) {
if (scheme_is_rational_positive(o))
return o;
else
return scheme_rational_negate(o);
}
NEED_REAL(abs);
ESCAPED_BEFORE_HERE;
}
static Scheme_Object *
minus (int argc, Scheme_Object *argv[])
{
Scheme_Object *ret, *v;
ret = argv[0];
if (!SCHEME_NUMBERP(ret)) {
scheme_wrong_contract("-", "number?", 0, argc, argv);
ESCAPED_BEFORE_HERE;
}
if (argc == 1) {
if (SCHEME_FLOATP(ret)) {
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(ret))
return scheme_make_float(-SCHEME_FLT_VAL(ret));
#endif
return scheme_make_double(-SCHEME_DBL_VAL(ret));
}
return scheme_bin_minus(zeroi, ret);
}
if (argc == 2) {
v = argv[1];
if (!SCHEME_NUMBERP(v)) {
scheme_wrong_contract("-", "number?", 1, argc, argv);
ESCAPED_BEFORE_HERE;
}
return scheme_bin_minus(ret, v);
}
return minus_slow(ret, argc, argv);
}
Scheme_Object *
scheme_sub1 (int argc, Scheme_Object *argv[])
{
Scheme_Type t;
Scheme_Object *o = argv[0];
if (SCHEME_INTP(o)) {
intptr_t v;
v = SCHEME_INT_VAL(o);
if (v > -(0x3FFFFFFF))
return scheme_make_integer(SCHEME_INT_VAL(o) - 1);
else {
Small_Bignum b;
return scheme_bignum_sub1(scheme_make_small_bignum(v, &b));
}
}
t = _SCHEME_TYPE(o);
#ifdef MZ_USE_SINGLE_FLOATS
if (t == scheme_float_type)
return scheme_make_float(SCHEME_FLT_VAL(o) - 1.0f);
#endif
if (t == scheme_double_type)
return scheme_make_double(SCHEME_DBL_VAL(o) - 1.0);
if (t == scheme_bignum_type)
return scheme_bignum_sub1(o);
if (t == scheme_rational_type)
return scheme_rational_sub1(o);
if (t == scheme_complex_type)
return scheme_complex_sub1(o);
NEED_NUMBER(sub1);
ESCAPED_BEFORE_HERE;
}
Scheme_Object *scheme_rational_power(const Scheme_Object *o, const Scheme_Object *p)
{
double b, e, v;
if (((Scheme_Rational *)p)->denom == one) {
Scheme_Object *a[2], *n;
a[0] = ((Scheme_Rational *)o)->num;
a[1] = ((Scheme_Rational *)p)->num;
n = scheme_expt(2, a);
a[0] = ((Scheme_Rational *)o)->denom;
return make_rational(n, scheme_expt(2, a), 0);
}
if (scheme_is_rational_positive(o)) {
b = scheme_rational_to_double(o);
e = scheme_rational_to_double(p);
v = pow(b, e);
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
return scheme_make_float(v);
#else
return scheme_make_double(v);
#endif
} else {
return scheme_complex_power(scheme_real_to_complex(o),
scheme_real_to_complex(p));
}
}
Scheme_Object *scheme_complex_power(const Scheme_Object *base, const Scheme_Object *exponent)
{
Scheme_Complex *cb = (Scheme_Complex *)base;
Scheme_Complex *ce = (Scheme_Complex *)exponent;
double a, b, c, d, bm, ba, nm, na, r1, r2;
int d_is_zero;
if ((ce->i == zero) && !SCHEME_FLOATP(ce->r)) {
if (SCHEME_INTP(ce->r) || SCHEME_BIGNUMP(ce->r))
return scheme_generic_integer_power(base, ce->r);
}
a = scheme_get_val_as_double(cb->r);
b = scheme_get_val_as_double(cb->i);
c = scheme_get_val_as_double(ce->r);
d = scheme_get_val_as_double(ce->i);
d_is_zero = (ce->i == zero);
bm = sqrt(a * a + b * b);
ba = atan2(b, a);
/* New mag & angle */
nm = scheme_double_expt(bm, c) * exp(-(ba * d));
if (d_is_zero) /* precision here can avoid NaNs */
na = ba * c;
else
na = log(bm) * d + ba * c;
r1 = nm * cos(na);
r2 = nm * sin(na);
#ifdef MZ_USE_SINGLE_FLOATS
/* Coerce to double or float? */
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
if (!SCHEME_DBLP(cb->r) && !SCHEME_DBLP(cb->i)
&& !SCHEME_DBLP(ce->r) && !SCHEME_DBLP(ce->i))
#else
if (SCHEME_FLTP(cb->r) && SCHEME_FLTP(cb->i)
&& SCHEME_FLTP(ce->r) && SCHEME_FLTP(ce->i))
#endif
return scheme_make_complex(scheme_make_float((float)r1),
scheme_make_float((float)r2));
#endif
return scheme_make_complex(scheme_make_double(r1),
scheme_make_double(r2));
}
Scheme_Object *scheme_complex_sqrt(const Scheme_Object *o)
{
Scheme_Complex *c = (Scheme_Complex *)o;
Scheme_Object *r, *i, *ssq, *srssq, *nrsq, *prsq, *nr, *ni;
r = c->r;
i = c->i;
if (scheme_is_zero(i)) {
/* Special case for x+0.0i: */
r = scheme_sqrt(1, &r);
if (!SCHEME_COMPLEXP(r))
return scheme_make_complex(r, i);
else {
c = (Scheme_Complex *)r;
if (SAME_OBJ(c->r, zero)) {
/* need an inexact-zero real part: */
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(c->i))
r = scheme_make_float(0.0);
else
#endif
r = scheme_make_double(0.0);
return scheme_make_complex(r, c->i);
} else
return r;
}
}
ssq = scheme_bin_plus(scheme_bin_mult(r, r),
scheme_bin_mult(i, i));
srssq = scheme_sqrt(1, &ssq);
if (SCHEME_FLOATP(srssq)) {
/* We may have lost too much precision, if i << r. The result is
going to be inexact, anyway, so switch to using expt. */
Scheme_Object *a[2];
a[0] = (Scheme_Object *)o;
a[1] = scheme_make_double(0.5);
return scheme_expt(2, a);
}
nrsq = scheme_bin_div(scheme_bin_minus(srssq, r),
scheme_make_integer(2));
nr = scheme_sqrt(1, &nrsq);
if (scheme_is_negative(i))
nr = scheme_bin_minus(zero, nr);
prsq = scheme_bin_div(scheme_bin_plus(srssq, r),
scheme_make_integer(2));
ni = scheme_sqrt(1, &prsq);
return scheme_make_complex(ni, nr);
}
Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
{
Scheme_Rational *r = (Scheme_Rational *)o;
Scheme_Object *n, *d;
double v;
n = scheme_integer_sqrt(r->num);
if (!SCHEME_DBLP(n)) {
d = scheme_integer_sqrt(r->denom);
if (!SCHEME_DBLP(d))
return make_rational(n, d, 0);
}
v = sqrt(scheme_rational_to_double(o));
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
return scheme_make_float(v);
#else
return scheme_make_double(v);
#endif
}
static Scheme_Object *
rem_mod (int argc, Scheme_Object *argv[], char *name, int first_sign)
{
Scheme_Object *n1, *n2, *r;
int negate;
n1 = argv[0];
n2 = argv[1];
if (!scheme_is_integer(n1))
scheme_wrong_contract(name, "integer?", 0, argc, argv);
if (!scheme_is_integer(n2))
scheme_wrong_contract(name, "integer?", 1, argc, argv);
if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2))
scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
"%s: undefined for 0", name);
if (
#ifdef MZ_USE_SINGLE_FLOATS
(SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) ||
#endif
(SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0))) {
int neg;
neg = scheme_minus_zero_p(SCHEME_FLOAT_VAL(n2));
scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
"%s: undefined for %s0.0",
name,
neg ? "-" : "");
}
if (SCHEME_INTP(n1) && !SCHEME_INT_VAL(n1))
return zeroi;
if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) {
intptr_t a, b, na, nb, v;
int neg1, neg2;
a = SCHEME_INT_VAL(n1);
b = SCHEME_INT_VAL(n2);
na = (a < 0) ? -a : a;
nb = (b < 0) ? -b : b;
v = na % nb;
if (v) {
if (first_sign) {
if (a < 0)
v = -v;
} else {
neg1 = (a < 0);
neg2 = (b < 0);
if (neg1 != neg2)
v = nb - v;
if (neg2)
v = -v;
}
}
return scheme_make_integer(v);
}
if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) {
double a, b, na, nb, v;
#ifdef MZ_USE_SINGLE_FLOATS
int was_single = !(SCHEME_DBLP(n1) || SCHEME_DBLP(n2));
#endif
if (SCHEME_INTP(n1))
a = SCHEME_INT_VAL(n1);
#ifdef MZ_USE_SINGLE_FLOATS
else if (SCHEME_FLTP(n1))
a = SCHEME_FLT_VAL(n1);
#endif
else if (SCHEME_DBLP(n1))
a = SCHEME_DBL_VAL(n1);
else
a = scheme_bignum_to_double(n1);
if (SCHEME_INTP(n2))
b = SCHEME_INT_VAL(n2);
#ifdef MZ_USE_SINGLE_FLOATS
else if (SCHEME_FLTP(n2))
b = SCHEME_FLT_VAL(n2);
#endif
else if (SCHEME_DBLP(n2))
b = SCHEME_DBL_VAL(n2);
else
b = scheme_bignum_to_double(n2);
if (a == 0.0) {
/* Avoid sign problems. */
#ifdef MZ_USE_SINGLE_FLOATS
if (was_single)
return scheme_zerof;
#endif
return scheme_zerod;
}
na = (a < 0) ? -a : a;
nb = (b < 0) ? -b : b;
if (MZ_IS_POS_INFINITY(nb))
v = na;
else if (MZ_IS_POS_INFINITY(na)) {
#ifdef MZ_USE_SINGLE_FLOATS
if (was_single)
return scheme_zerof;
#endif
return scheme_zerod;
} else {
v = fmod(na, nb);
#ifdef FMOD_CAN_RETURN_NEG_ZERO
if (v == 0.0)
v = 0.0;
#endif
}
if (v) {
if (first_sign) {
/* remainder */
if (a < 0)
v = -v;
} else {
/* modulo */
int neg1, neg2;
neg1 = (a < 0);
neg2 = (b < 0);
if (neg1 != neg2)
v = nb - v;
if (neg2)
v = -v;
}
}
#ifdef MZ_USE_SINGLE_FLOATS
if (was_single)
return scheme_make_float((float)v);
#endif
return scheme_make_double(v);
}
n1 = scheme_to_bignum(n1);
n2 = scheme_to_bignum(n2);
scheme_bignum_divide(n1, n2, NULL, &r, 1);
negate = 0;
if (!SCHEME_INTP(r) || SCHEME_INT_VAL(r)) {
/* Easier if we can assume 'r' is positive: */
if (SCHEME_INTP(r)) {
if (SCHEME_INT_VAL(r) < 0)
r = scheme_make_integer(-SCHEME_INT_VAL(r));
} else if (!SCHEME_BIGPOS(r))
r = scheme_bignum_negate(r);
if (first_sign) {
if (!SCHEME_BIGPOS(n1))
negate = 1;
} else {
int neg1, neg2;
neg1 = !SCHEME_BIGPOS(n1);
neg2 = !SCHEME_BIGPOS(n2);
if (neg1 != neg2) {
if (neg2)
r = scheme_bin_plus(n2, r);
else
r = scheme_bin_minus(n2, r);
} else if (neg2)
negate = 1;
}
if (negate) {
if (SCHEME_INTP(r))
r = scheme_make_integer(-SCHEME_INT_VAL(r));
else
r = scheme_bignum_negate(r);
}
}
return r;
}
Scheme_Object *
do_bin_quotient(const char *name, const Scheme_Object *n1, const Scheme_Object *n2, Scheme_Object **bn_rem)
{
Scheme_Object *q;
if (!scheme_is_integer(n1)) {
Scheme_Object *a[2];
a[0] = (Scheme_Object *)n1;
a[1] = (Scheme_Object *)n2;
scheme_wrong_contract(name, "integer?", 0, 2, a);
}
if (!scheme_is_integer(n2)) {
Scheme_Object *a[2];
a[0] = (Scheme_Object *)n1;
a[1] = (Scheme_Object *)n2;
scheme_wrong_contract(name, "integer?", 1, 2, a);
}
if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2))
scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
"%s: undefined for 0", name);
if (
#ifdef MZ_USE_SINGLE_FLOATS
(SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) ||
#endif
(SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0)))
scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
"%s: undefined for 0.0", name);
if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) {
/* Beware that most negative fixnum divided by -1
isn't a fixnum: */
return (scheme_make_integer_value(SCHEME_INT_VAL(n1) / SCHEME_INT_VAL(n2)));
}
if (SCHEME_DBLP(n1) || SCHEME_DBLP(n2)) {
Scheme_Object *r;
double d, d2;
r = scheme_bin_div(n1, n2); /* could be exact 0 ... */
if (SCHEME_DBLP(r)) {
d = SCHEME_DBL_VAL(r);
if (d > 0)
d2 = floor(d);
else
d2 = ceil(d);
if (d2 == d)
return r;
else
return scheme_make_double(d2);
} else
return r;
}
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(n1) || SCHEME_FLTP(n2)) {
Scheme_Object *r;
float d, d2;
r = scheme_bin_div(n1, n2); /* could be exact 0 ... */
if (SCHEME_FLTP(r)) {
d = SCHEME_FLT_VAL(r);
if (d > 0)
d2 = floor(d);
else
d2 = ceil(d);
if (d2 == d)
return r;
else
return scheme_make_float(d2);
} else
return r;
}
#endif
#if 0
/* I'm pretty sure this isn't needed, but I'm keeping the code just
in case... 03/19/2000 */
if (SCHEME_RATIONALP(n1))
wrong_contract(name, "integer?", n1);
if (SCHEME_RATIONALP(n2))
wrong_contract(name, "integer?", n2);
#endif
n1 = scheme_to_bignum(n1);
n2 = scheme_to_bignum(n2);
scheme_bignum_divide(n1, n2, &q, bn_rem, 1);
return q;
}
Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht)
{
Scheme_Object *new_so = so;
if (SCHEME_INTP(so)) {
return so;
}
if (ht) {
Scheme_Object *r;
if ((r = scheme_hash_get(ht, so))) {
return r;
}
}
switch (so->type) {
case scheme_true_type:
case scheme_false_type:
case scheme_null_type:
case scheme_void_type:
/* place_bi_channels are allocated in the master and can be passed along as is */
case scheme_place_bi_channel_type:
new_so = so;
break;
case scheme_place_type:
new_so = ((Scheme_Place *) so)->channel;
break;
case scheme_char_type:
new_so = scheme_make_char(SCHEME_CHAR_VAL(so));
break;
case scheme_rational_type:
{
Scheme_Object *n;
Scheme_Object *d;
n = scheme_rational_numerator(so);
d = scheme_rational_denominator(so);
n = scheme_places_deep_copy_worker(n, ht);
d = scheme_places_deep_copy_worker(d, ht);
new_so = scheme_make_rational(n, d);
}
break;
case scheme_float_type:
new_so = scheme_make_float(SCHEME_FLT_VAL(so));
break;
case scheme_double_type:
new_so = scheme_make_double(SCHEME_DBL_VAL(so));
break;
case scheme_complex_type:
{
Scheme_Object *r;
Scheme_Object *i;
r = scheme_complex_real_part(so);
i = scheme_complex_imaginary_part(so);
r = scheme_places_deep_copy_worker(r, ht);
i = scheme_places_deep_copy_worker(i, ht);
new_so = scheme_make_complex(r, i);
}
break;
case scheme_char_string_type:
new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1);
break;
case scheme_byte_string_type:
if (SHARED_ALLOCATEDP(so)) {
new_so = so;
}
else {
new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
}
break;
case scheme_unix_path_type:
new_so = scheme_make_sized_offset_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
break;
case scheme_symbol_type:
if (SCHEME_SYM_UNINTERNEDP(so)) {
scheme_log_abort("cannot copy uninterned symbol");
abort();
} else {
new_so = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(so), 0, SCHEME_SYM_LEN(so), 1);
new_so->type = scheme_serialized_symbol_type;
}
break;
case scheme_serialized_symbol_type:
new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so));
break;
case scheme_pair_type:
{
Scheme_Object *car;
Scheme_Object *cdr;
Scheme_Object *pair;
car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht);
cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht);
pair = scheme_make_pair(car, cdr);
new_so = pair;
}
break;
case scheme_vector_type:
{
Scheme_Object *vec;
intptr_t i;
intptr_t size = SCHEME_VEC_SIZE(so);
vec = scheme_make_vector(size, 0);
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht);
SCHEME_VEC_ELS(vec)[i] = tmp;
}
SCHEME_SET_IMMUTABLE(vec);
new_so = vec;
}
break;
case scheme_fxvector_type:
if (SHARED_ALLOCATEDP(so)) {
new_so = so;
}
else {
Scheme_Vector *vec;
intptr_t i;
intptr_t size = SCHEME_FXVEC_SIZE(so);
vec = scheme_alloc_fxvector(size);
for (i = 0; i < size; i++) {
SCHEME_FXVEC_ELS(vec)[i] = SCHEME_FXVEC_ELS(so)[i];
}
new_so = (Scheme_Object *) vec;
}
break;
case scheme_flvector_type:
if (SHARED_ALLOCATEDP(so)) {
new_so = so;
}
else {
Scheme_Double_Vector *vec;
intptr_t i;
intptr_t size = SCHEME_FLVEC_SIZE(so);
vec = scheme_alloc_flvector(size);
for (i = 0; i < size; i++) {
SCHEME_FLVEC_ELS(vec)[i] = SCHEME_FLVEC_ELS(so)[i];
}
new_so = (Scheme_Object *) vec;
}
break;
case scheme_structure_type:
{
Scheme_Structure *st = (Scheme_Structure*)so;
Scheme_Serialized_Structure *nst;
Scheme_Struct_Type *stype = st->stype;
Scheme_Struct_Type *ptype = stype->parent_types[stype->name_pos - 1];
Scheme_Object *nprefab_key;
intptr_t size = stype->num_slots;
int local_slots = stype->num_slots - (ptype ? ptype->num_slots : 0);
int i = 0;
if (!stype->prefab_key) {
scheme_log_abort("cannot copy non prefab structure");
abort();
}
{
for (i = 0; i < local_slots; i++) {
if (!stype->immutables || stype->immutables[i] != 1) {
scheme_log_abort("cannot copy mutable prefab structure");
abort();
}
}
}
nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht);
nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size);
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
nst->slots[i] = tmp;
}
new_so = (Scheme_Object*) nst;
}
break;
case scheme_serialized_structure_type:
{
Scheme_Serialized_Structure *st = (Scheme_Serialized_Structure*)so;
Scheme_Struct_Type *stype;
Scheme_Structure *nst;
intptr_t size;
int i = 0;
size = st->num_slots;
stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size);
nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype);
for (i = 0; i <size ; i++) {
Scheme_Object *tmp;
tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
nst->slots[i] = tmp;
}
new_so = (Scheme_Object*)nst;
}
break;
case scheme_resolved_module_path_type:
default:
printf("places deep copy cannot copy object of type %hi at %p\n", so->type, so);
scheme_log_abort("places deep copy cannot copy object");
abort();
break;
}
if (ht) {
scheme_hash_set(ht, so, new_so);
}
return new_so;
}
