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

Better initial defaults for equality bounds checking.

Browse source
This commit is contained in:
Alex Shinn 2013-01-26 23:42:22 +09:00
parent ed308c4063
commit 55df642dab
5 changed files with 16 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
include/chibi/features.h
View file

@ -613,8 +613,12 @@
#define SEXP_MAX_STACK_SIZE SEXP_INIT_STACK_SIZE*1000
#endif
#ifndef SEXP_DEFAULT_EQUAL_DEPTH
#define SEXP_DEFAULT_EQUAL_DEPTH 10000
#endif
#ifndef SEXP_DEFAULT_EQUAL_BOUND
#define SEXP_DEFAULT_EQUAL_BOUND 100000
#define SEXP_DEFAULT_EQUAL_BOUND 100000000
#endif
#ifndef SEXP_USE_IMAGE_LOADING

2
include/chibi/sexp.h
View file

@ -1317,7 +1317,7 @@ SEXP_API sexp sexp_alloc_tagged_aux(sexp ctx, size_t size, sexp_uint_t tag sexp_
SEXP_API sexp sexp_make_context(sexp ctx, size_t size, size_t max_size);
SEXP_API sexp sexp_cons_op(sexp ctx, sexp self, sexp_sint_t n, sexp head, sexp tail);
SEXP_API sexp sexp_list2(sexp ctx, sexp a, sexp b);
SEXP_API sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp bound);
SEXP_API sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp depth, sexp bound);
SEXP_API sexp sexp_equalp_op (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b);
SEXP_API sexp sexp_listp_op(sexp ctx, sexp self, sexp_sint_t n, sexp obj);
SEXP_API sexp sexp_reverse_op(sexp ctx, sexp self, sexp_sint_t n, sexp ls);

2
lib/chibi/equiv.scm
View file

@ -45,5 +45,5 @@
(lp (- i 1))))))))))
(else
(equal? a b))))
(let ((res (equal?/bounded a b 1000000)))
(let ((res (equal?/bounded a b 100000 100000)))
(and res (or (> res 0) (equiv? a b)) #t))))

2
opcodes.c
View file

@ -147,7 +147,7 @@ _FN1OPTP(_I(SEXP_OBJECT), _I(SEXP_IPORT), "read", (sexp)"current-input-port", se
_FN2OPTP(SEXP_VOID,_I(SEXP_OBJECT), _I(SEXP_OPORT), "write", (sexp)"current-output-port", sexp_write_op),
_FN1OPTP(SEXP_VOID, _I(SEXP_OPORT), "flush-output", (sexp)"current-output-port", sexp_flush_output_op),
_FN2(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), _I(SEXP_OBJECT), "equal?", 0, sexp_equalp_op),
_FN3(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_OBJECT), "equal?/bounded", 0, sexp_equalp_bound),
_FN4(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_OBJECT), "equal?/bounded", 0, sexp_equalp_bound),
_FN1(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "list?", 0, sexp_listp_op),
_FN1(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "identifier?", 0, sexp_identifierp_op),
_FN1(_I(SEXP_SYMBOL), _I(SEXP_OBJECT), "identifier->symbol", 0, sexp_syntactic_closure_expr_op),

13
sexp.c
View file

@ -777,10 +777,10 @@ sexp sexp_length_op (sexp ctx, sexp self, sexp_sint_t n, sexp ls1) {
return sexp_make_fixnum(res + (sexp_pairp(ls2) ? 1 : 0));
}
sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp bound) {
sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp depth, sexp bound) {
sexp_uint_t left_size, right_size;
sexp_sint_t i, len;
sexp t, *p, *q;
sexp t, *p, *q, depth2;
char *p_left, *p_right, *q_left, *q_right;
loop:
@ -799,8 +799,10 @@ sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp
if (sexp_pointer_tag(a) == SEXP_FLONUM)
return sexp_flonum_eqv(a, b) ? bound : SEXP_FALSE;
#endif
if (sexp_unbox_fixnum(bound) < 0) /* exceeded limit */
/* check limits */
if (sexp_unbox_fixnum(bound) < 0 || sexp_unbox_fixnum(depth) < 0)
return bound;
depth2 = sexp_fx_sub(depth, SEXP_ONE);
bound = sexp_fx_sub(bound, SEXP_ONE);
t = sexp_object_type(ctx, a);
p_left = ((char*)a) + offsetof(struct sexp_struct, value);
@ -836,10 +838,10 @@ sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp
}
}
for (i=0; i<len-1; i++) {
bound = sexp_equalp_bound(ctx, self, n, p[i], q[i], bound);
bound = sexp_equalp_bound(ctx, self, n, p[i], q[i], depth2, bound);
if (sexp_not(bound)) return SEXP_FALSE;
}
/* tail-recurse on the last value */
/* tail-recurse on the last value (same depth) */
a = p[len-1]; b = q[len-1]; goto loop;
}
return bound;
@ -848,6 +850,7 @@ sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp
sexp sexp_equalp_op (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b) {
return sexp_make_boolean(
sexp_truep(sexp_equalp_bound(ctx, self, n, a, b,
sexp_make_fixnum(SEXP_DEFAULT_EQUAL_DEPTH),
sexp_make_fixnum(SEXP_DEFAULT_EQUAL_BOUND))));
}