Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 19:56:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Disabling brace literal write syntax by default when not using srfi-38.

Browse source
This commit is contained in:
Alex Shinn 2011-11-07 01:04:31 +09:00
parent aa1363cb9e
commit e65ed61b26
3 changed files with 17 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
include/chibi/features.h
View file

@ -428,6 +428,11 @@
#define SEXP_USE_OBJECT_BRACE_LITERALS (SEXP_USE_TYPE_DEFS && !SEXP_USE_NO_FEATURES) #define SEXP_USE_OBJECT_BRACE_LITERALS (SEXP_USE_TYPE_DEFS && !SEXP_USE_NO_FEATURES)
#endif #endif
/* Dangerous without shared object detection. */
#ifndef SEXP_USE_TYPE_PRINTERS
#define SEXP_USE_TYPE_PRINTERS 0
#endif
#ifndef SEXP_USE_BYTEVECTOR_LITERALS #ifndef SEXP_USE_BYTEVECTOR_LITERALS
#define SEXP_USE_BYTEVECTOR_LITERALS ! SEXP_USE_NO_FEATURES #define SEXP_USE_BYTEVECTOR_LITERALS ! SEXP_USE_NO_FEATURES
#endif #endif

16
lib/srfi/38.scm
View file

@ -19,16 +19,16 @@
((= i (vector-length x))) ((= i (vector-length x)))
(find (vector-ref x i)))) (find (vector-ref x i))))
(else (else
(let* ((type (type-of x)) (let ((type (type-of x)))
(slots (and type (type-slots type))))
(cond (cond
(slots ((and type (type-printer type))
(set! seen (cons (cons x 1) seen)) (set! seen (cons (cons x 1) seen))
(let lp ((i 0) (ls slots)) (let ((num-slots (type-num-slots type)))
(cond (let lp ((i 0))
((pair? ls) (cond
(find (slot-ref type x i)) ((< i num-slots)
(lp (+ i 1) (cdr ls))))))))))) (find (slot-ref type x i))
(lp (+ i 1))))))))))))
(let extract ((ls seen) (res '())) (let extract ((ls seen) (res '()))
(cond (cond
((null? ls) res) ((null? ls) res)

4
sexp.c
View file

@ -1583,14 +1583,18 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
sexp_write_char(ctx, '>', out); sexp_write_char(ctx, '>', out);
} else { } else {
x = sexp_type_by_index(ctx, i); x = sexp_type_by_index(ctx, i);
#if SEXP_USE_TYPE_PRINTERS
if (sexp_type_print(x)) { if (sexp_type_print(x)) {
x = sexp_apply_writer(ctx, sexp_type_print(x), obj, out); x = sexp_apply_writer(ctx, sexp_type_print(x), obj, out);
if (sexp_exceptionp(x)) return x; if (sexp_exceptionp(x)) return x;
} else { } else {
#endif
sexp_write_string(ctx, "#<", out); sexp_write_string(ctx, "#<", out);
sexp_display(ctx, sexp_type_name(x), out); sexp_display(ctx, sexp_type_name(x), out);
sexp_write_char(ctx, '>', out); sexp_write_char(ctx, '>', out);
#if SEXP_USE_TYPE_PRINTERS
} }
#endif
} }
break; break;
} }