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 #define SEXP_MAX_STACK_SIZE SEXP_INIT_STACK_SIZE*1000
#endif #endif
#ifndef SEXP_DEFAULT_EQUAL_DEPTH
#define SEXP_DEFAULT_EQUAL_DEPTH 10000
#endif
#ifndef SEXP_DEFAULT_EQUAL_BOUND #ifndef SEXP_DEFAULT_EQUAL_BOUND
#define SEXP_DEFAULT_EQUAL_BOUND 100000 #define SEXP_DEFAULT_EQUAL_BOUND 100000000
#endif #endif
#ifndef SEXP_USE_IMAGE_LOADING #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_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_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_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_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_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); 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)))))))))) (lp (- i 1))))))))))
(else (else
(equal? a b)))) (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)))) (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), _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), _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), _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), "list?", 0, sexp_listp_op),
_FN1(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "identifier?", 0, sexp_identifierp_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), _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)); 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_uint_t left_size, right_size;
sexp_sint_t i, len; sexp_sint_t i, len;
sexp t, *p, *q; sexp t, *p, *q, depth2;
char *p_left, *p_right, *q_left, *q_right; char *p_left, *p_right, *q_left, *q_right;
loop: 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) if (sexp_pointer_tag(a) == SEXP_FLONUM)
return sexp_flonum_eqv(a, b) ? bound : SEXP_FALSE; return sexp_flonum_eqv(a, b) ? bound : SEXP_FALSE;
#endif #endif
if (sexp_unbox_fixnum(bound) < 0) /* exceeded limit */ /* check limits */
if (sexp_unbox_fixnum(bound) < 0 || sexp_unbox_fixnum(depth) < 0)
return bound; return bound;
depth2 = sexp_fx_sub(depth, SEXP_ONE);
bound = sexp_fx_sub(bound, SEXP_ONE); bound = sexp_fx_sub(bound, SEXP_ONE);
t = sexp_object_type(ctx, a); t = sexp_object_type(ctx, a);
p_left = ((char*)a) + offsetof(struct sexp_struct, value); 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++) { 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; 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; a = p[len-1]; b = q[len-1]; goto loop;
} }
return bound; 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) { sexp sexp_equalp_op (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b) {
return sexp_make_boolean( return sexp_make_boolean(
sexp_truep(sexp_equalp_bound(ctx, self, n, a, b, sexp_truep(sexp_equalp_bound(ctx, self, n, a, b,
sexp_make_fixnum(SEXP_DEFAULT_EQUAL_DEPTH),
sexp_make_fixnum(SEXP_DEFAULT_EQUAL_BOUND)))); sexp_make_fixnum(SEXP_DEFAULT_EQUAL_BOUND))));
} }