diff --git a/include/chibi/features.h b/include/chibi/features.h index 2aa8a27b..6c34b4a7 100644 --- a/include/chibi/features.h +++ b/include/chibi/features.h @@ -417,6 +417,10 @@ #define SEXP_USE_ESCAPE_REQUIRES_TRAILING_SEMI_COLON SEXP_USE_PEDANTIC #endif +#ifndef SEXP_USE_OBJECT_BRACE_LITERALS +#define SEXP_USE_OBJECT_BRACE_LITERALS ! SEXP_USE_NO_FEATURES +#endif + #ifndef SEXP_USE_SELF_PARAMETER #define SEXP_USE_SELF_PARAMETER 1 #endif diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 46e7661b..b35bd4c9 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -103,8 +103,12 @@ enum sexp_types { SEXP_VECTOR, SEXP_FLONUM, SEXP_BIGNUM, +#if SEXP_USE_RATIOS SEXP_RATIO, +#endif +#if SEXP_USE_COMPLEX SEXP_COMPLEX, +#endif SEXP_IPORT, SEXP_OPORT, SEXP_EXCEPTION, @@ -229,6 +233,7 @@ struct sexp_type_struct { char *name; sexp cpl, slots; sexp_proc2 finalize; + sexp_proc3 print; }; struct sexp_opcode_struct { @@ -396,6 +401,9 @@ struct sexp_struct { #define SEXP_UNDEF SEXP_MAKE_IMMEDIATE(5) /* internal use */ #define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(6) /* internal use */ #define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(7) /* internal use */ +#if SEXP_USE_OBJECT_BRACE_LITERALS +#define SEXP_CLOSE_BRACE SEXP_MAKE_IMMEDIATE(8) /* internal use */ +#endif #if SEXP_USE_LIMITED_MALLOC void* sexp_malloc(size_t size); @@ -951,6 +959,7 @@ SEXP_API sexp_heap sexp_global_heap; #define sexp_type_cpl(x) (sexp_field(x, type, SEXP_TYPE, cpl)) #define sexp_type_slots(x) (sexp_field(x, type, SEXP_TYPE, slots)) #define sexp_type_finalize(x) (sexp_field(x, type, SEXP_TYPE, finalize)) +#define sexp_type_print(x) (sexp_field(x, type, SEXP_TYPE, print)) #define sexp_bignum_sign(x) (sexp_field(x, bignum, SEXP_BIGNUM, sign)) #define sexp_bignum_length(x) (sexp_field(x, bignum, SEXP_BIGNUM, length)) @@ -1118,6 +1127,7 @@ SEXP_API sexp sexp_read_raw (sexp ctx, sexp in); SEXP_API sexp sexp_read_op (sexp ctx sexp_api_params(self, n), sexp in); SEXP_API sexp sexp_read_from_string (sexp ctx, const char *str, sexp_sint_t len); SEXP_API sexp sexp_write_to_string (sexp ctx, sexp obj); +SEXP_API sexp sexp_write_simple_object (sexp ctx sexp_api_params(self, n), sexp obj, sexp out); SEXP_API sexp sexp_finalize_port (sexp ctx sexp_api_params(self, n), sexp port); SEXP_API sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name); SEXP_API sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name); @@ -1179,7 +1189,7 @@ SEXP_API int sexp_valid_object_p(sexp ctx, sexp x); #endif #if SEXP_USE_TYPE_DEFS -SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2); +SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2, sexp_proc3); SEXP_API sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp parent, sexp slots); SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj); #define sexp_register_c_type(ctx, name, finalizer) \ @@ -1187,7 +1197,8 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj) SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \ sexp_make_fixnum(sexp_sizeof(cpointer)), \ SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \ - SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer) + SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer, \ + NULL) #endif #define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE)) @@ -1224,7 +1235,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj) #define sexp_get_output_string(ctx, out) sexp_get_output_string_op(ctx sexp_api_pass(NULL, 1), out) #define sexp_expt(ctx, a, b) sexp_expt_op(ctx sexp_api_pass(NULL, 2), a, b) #define sexp_register_simple_type(ctx, a, b, c) sexp_register_simple_type_op(ctx sexp_api_pass(NULL, 3), a, b, c) -#define sexp_register_type(ctx, a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r) sexp_register_type_op(ctx sexp_api_pass(NULL, 17), a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r) +#define sexp_register_type(ctx, a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r, s) sexp_register_type_op(ctx sexp_api_pass(NULL, 18), a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r, s) #define sexp_make_type_predicate(ctx, a, b) sexp_make_type_predicate_op(ctx sexp_api_pass(NULL, 2), a, b) #define sexp_make_constructor(ctx, a, b) sexp_make_constructor_op(ctx sexp_api_pass(NULL, 2), a, b) #define sexp_make_getter(ctx, a, b, c) sexp_make_getter_op(ctx sexp_api_pass(NULL, 3), a, b, c) diff --git a/lib/chibi/test.module b/lib/chibi/test.module index 6a73c443..cb6abf0f 100644 --- a/lib/chibi/test.module +++ b/lib/chibi/test.module @@ -7,6 +7,7 @@ ;; test-vars test-run ;; test-exit current-test-verbosity current-test-epsilon current-test-comparator current-test-applier current-test-handler current-test-skipper - current-test-group-reporter test-failure-count) + current-test-group-reporter test-failure-count + current-test-epsilon current-test-comparator) (import (scheme) (srfi 39) (srfi 98) (chibi time) (chibi ast)) (include "test.scm")) diff --git a/lib/srfi/18/threads.c b/lib/srfi/18/threads.c index 5572dca7..fb34f971 100644 --- a/lib/srfi/18/threads.c +++ b/lib/srfi/18/threads.c @@ -561,7 +561,8 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, sexp_make_fixnum(sexp_sizeof_pollfds), SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, - SEXP_ZERO, SEXP_ZERO, (sexp_proc2)sexp_free_pollfds); + SEXP_ZERO, SEXP_ZERO, (sexp_proc2)sexp_free_pollfds, + NULL); if (sexp_typep(t)) sexp_pollfds_id = sexp_type_tag(t); diff --git a/lib/srfi/27/rand.c b/lib/srfi/27/rand.c index 7efd03f9..f781eaee 100644 --- a/lib/srfi/27/rand.c +++ b/lib/srfi/27/rand.c @@ -175,8 +175,8 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { op = sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE, sexp_make_fixnum(sexp_offsetof_slot0), ONE, ONE, ZERO, ZERO, - sexp_make_fixnum(sexp_sizeof_random), - ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, NULL); + sexp_make_fixnum(sexp_sizeof_random), ZERO, + ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, NULL, NULL); if (sexp_exceptionp(op)) return op; rs_type_id = sexp_type_tag(op); diff --git a/opt/bignum.c b/opt/bignum.c index 4262f27b..40d35c92 100644 --- a/opt/bignum.c +++ b/opt/bignum.c @@ -756,8 +756,12 @@ enum sexp_number_types { SEXP_NUM_FIX, SEXP_NUM_FLO, SEXP_NUM_BIG, +#if SEXP_USE_RATIOS SEXP_NUM_RAT, +#endif +#if SEXP_USE_COMPLEX SEXP_NUM_CPX, +#endif }; enum sexp_number_combs { @@ -824,12 +828,22 @@ enum sexp_number_combs { }; static int sexp_number_types[] = +#if SEXP_USE_RATIOS && SEXP_USE_COMPLEX {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 4, 5, 0, 0}; +#else +#if SEXP_USE_RATIOS || SEXP_USE_COMPLEX + {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 4, 0, 0, 0}; +#else + {0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 0, 0, 0, 0}; +#endif +#endif #define SEXP_NUM_NUMBER_TYPES (4 + SEXP_USE_RATIOS + SEXP_USE_COMPLEX) static int sexp_number_type (sexp a) { - return sexp_pointerp(a) ? sexp_number_types[sexp_pointer_tag(a)&15] + return sexp_pointerp(a) ? + (sexp_pointer_tag(a)<(sizeof(sexp_number_types)/sizeof(sexp_number_types[0])) + ? sexp_number_types[sexp_pointer_tag(a)] : 0) #if SEXP_USE_IMMEDIATE_FLONUMS : sexp_flonump(a) ? 2 #endif diff --git a/sexp.c b/sexp.c index 04343a75..21c21d81 100644 --- a/sexp.c +++ b/sexp.c @@ -29,6 +29,8 @@ static const char sexp_separators[] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, /* x3_ */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* x4_ */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, /* x5_ */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* x6_ */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, /* x7_ */ }; static int digit_value (int c) { @@ -40,7 +42,7 @@ static int hex_digit (int n) { } static int is_separator(int c) { - return 0", out); break; - case SEXP_SYNCLO: - sexp_write_string(ctx, "#", out); - break; case SEXP_TYPE: sexp_write_string(ctx, "#= 0) { sexp_write_string(ctx, "\\x", out); - sexp_write_char(ctx, hex_digit(str[0]>>8), out); + sexp_write_char(ctx, hex_digit(str[0]>>4), out); sexp_write_char(ctx, hex_digit(str[0]&0x0F), out); sexp_write_char(ctx, ';', out); } else { @@ -1409,12 +1448,21 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) { break; default: i = sexp_pointer_tag(obj); - sexp_write_string(ctx, "#<", out); - sexp_write_string(ctx, - (i < sexp_context_num_types(ctx)) - ? sexp_type_name_by_index(ctx, i) : "invalid", - out); - sexp_write_char(ctx, '>', out); + if (i < 0 || i >= sexp_context_num_types(ctx)) { + sexp_write_string(ctx, "#', out); + } else { + x = sexp_type_by_index(ctx, i); + if (sexp_type_print(x)) { + x = sexp_type_print(x)(ctx, NULL, 2, obj, out); + if (sexp_exceptionp(x)) return x; + } else { + sexp_write_string(ctx, "#<", out); + sexp_write_string(ctx, sexp_type_name(x), out); + sexp_write_char(ctx, '>', out); + } + } break; } } else if (sexp_fixnump(obj)) { @@ -2006,6 +2054,35 @@ sexp sexp_read_raw (sexp ctx, sexp in) { for (tmp=res; sexp_pairp(tmp); tmp=sexp_cdr(tmp)) sexp_immutablep(tmp) = 1; break; +#if SEXP_USE_OBJECT_BRACE_LITERALS + case '{': + res = sexp_read_symbol(ctx, in, EOF, 0); + if (!sexp_exceptionp(res)) { + tmp = sexp_find_type_by_name(ctx, res); + if (tmp && sexp_typep(tmp)) { + if (sexp_type_print(tmp) == sexp_write_simple_object) { + res = sexp_alloc_tagged(ctx, sexp_type_size_base(tmp), sexp_type_tag(tmp)); + for (c1=0; ; c1++) { + tmp2 = sexp_read(ctx, in); + if (sexp_exceptionp(tmp2)) { + res = tmp2; + break; + } else if (tmp2 == SEXP_CLOSE_BRACE) { + break; + } else if (c1 >= sexp_type_num_slots_of_object(ctx, tmp)) { + res = sexp_read_error(ctx, "too many slots in object literal", res, in); + break; + } else { + sexp_slot_set(res, c1, tmp2); + } + } + } else { + res = sexp_read_error(ctx, "invalid type for brace literals", tmp, in); + } + } + } + break; +#endif case '#': switch (c1=sexp_read_char(ctx, in)) { case 'b': @@ -2133,6 +2210,11 @@ sexp sexp_read_raw (sexp ctx, sexp in) { case ')': res = SEXP_CLOSE; break; +#if SEXP_USE_OBJECT_BRACE_LITERALS + case '}': + res = SEXP_CLOSE_BRACE; + break; +#endif case '+': case '-': c2 = sexp_read_char(ctx, in);