From e65ed61b2605f8ebfc665391de80b577b074ebb9 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Mon, 7 Nov 2011 01:04:31 +0900
Subject: [PATCH] Disabling brace literal write syntax by default when not
 using srfi-38.

---
 include/chibi/features.h |  5 +++++
 lib/srfi/38.scm          | 16 ++++++++--------
 sexp.c                   |  4 ++++
 3 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/include/chibi/features.h b/include/chibi/features.h
index 0776acdc..94219df5 100644
--- a/include/chibi/features.h
+++ b/include/chibi/features.h
@@ -428,6 +428,11 @@
 #define SEXP_USE_OBJECT_BRACE_LITERALS (SEXP_USE_TYPE_DEFS && !SEXP_USE_NO_FEATURES)
 #endif
 
+/* Dangerous without shared object detection. */
+#ifndef SEXP_USE_TYPE_PRINTERS
+#define SEXP_USE_TYPE_PRINTERS 0
+#endif
+
 #ifndef SEXP_USE_BYTEVECTOR_LITERALS
 #define SEXP_USE_BYTEVECTOR_LITERALS ! SEXP_USE_NO_FEATURES
 #endif
diff --git a/lib/srfi/38.scm b/lib/srfi/38.scm
index 72f64087..42f70510 100644
--- a/lib/srfi/38.scm
+++ b/lib/srfi/38.scm
@@ -19,16 +19,16 @@
             ((= i (vector-length x)))
           (find (vector-ref x i))))
        (else
-        (let* ((type (type-of x))
-               (slots (and type (type-slots type))))
+        (let ((type (type-of x)))
           (cond
-           (slots
+           ((and type (type-printer type))
             (set! seen (cons (cons x 1) seen))
-            (let lp ((i 0) (ls slots))
-              (cond
-               ((pair? ls)
-                (find (slot-ref type x i))
-                (lp (+ i 1) (cdr ls)))))))))))
+            (let ((num-slots (type-num-slots type)))
+              (let lp ((i 0))
+                (cond
+                 ((< i num-slots)
+                  (find (slot-ref type x i))
+                  (lp (+ i 1))))))))))))
     (let extract ((ls seen) (res '()))
       (cond
        ((null? ls) res)
diff --git a/sexp.c b/sexp.c
index 8c5e2966..8bf65477 100644
--- a/sexp.c
+++ b/sexp.c
@@ -1583,14 +1583,18 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
         sexp_write_char(ctx, '>', out);
       } else {
         x = sexp_type_by_index(ctx, i);
+#if SEXP_USE_TYPE_PRINTERS
         if (sexp_type_print(x)) {
           x = sexp_apply_writer(ctx, sexp_type_print(x), obj, out);
           if (sexp_exceptionp(x)) return x;
         } else {
+#endif
           sexp_write_string(ctx, "#<", out);
           sexp_display(ctx, sexp_type_name(x), out);
           sexp_write_char(ctx, '>', out);
+#if SEXP_USE_TYPE_PRINTERS
         }
+#endif
       }
       break;
     }