diff --git a/include/chibi/features.h b/include/chibi/features.h index 1021fb62..e6cf1dc6 100644 --- a/include/chibi/features.h +++ b/include/chibi/features.h @@ -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 diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 2b890510..14852c24 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -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); diff --git a/lib/chibi/equiv.scm b/lib/chibi/equiv.scm index ee6f073e..5dec1df9 100644 --- a/lib/chibi/equiv.scm +++ b/lib/chibi/equiv.scm @@ -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)))) diff --git a/opcodes.c b/opcodes.c index 971e8903..a5f89cf7 100644 --- a/opcodes.c +++ b/opcodes.c @@ -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), diff --git a/sexp.c b/sexp.c index 50404345..66685b09 100644 --- a/sexp.c +++ b/sexp.c @@ -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)))); }