diff --git a/lib/srfi/38.scm b/lib/srfi/38.scm
index 5e9a0fb6..544720f4 100644
--- a/lib/srfi/38.scm
+++ b/lib/srfi/38.scm
@@ -66,62 +66,60 @@
                       (set! count (+ count 1))))
                (cont x index)))))
     (let wr ((x x))
-      (check-shared
-       x
-       ""
-       (lambda (x shared?)
-         (cond
-          ((pair? x)
-           (display "(" out)
-           (wr (car x))
-           (let lp ((ls (cdr x)))
-             (check-shared
-              ls
-              " . "
-              (lambda (ls shared?)
-                (cond ((null? ls))
-                      ((pair? ls)
-                       (cond
-                        (shared?
-                         (display "(" out)
-                         (wr (car ls))
-                         (check-shared
-                          (cdr ls)
-                          " . "
-                          (lambda (ls shared?) (lp ls)))
-                         (display ")" out))
-                        (else
-                         (display " " out)
-                         (wr (car ls))
-                         (lp (cdr ls)))))
-                      (shared?  ;; shared dotted tail
-                       (write ls out))
-                      (else
-                       (display " . " out)
-                       (wr ls))))))
-           (display ")" out))
-          ((vector? x)
-           (display "#(" out)
-           (let ((len (vector-length x)))
-             (cond ((> len 0)
-                    (wr (vector-ref x 0))
-                    (do ((i 1 (+ i 1)))
-                        ((= i len))
-                      (display " " out)
-                      (wr (vector-ref x i))))))
-           (display ")" out))
-          ((let ((type (type-of x)))
-             (and (type? type) (type-printer type)))
-           => (lambda (printer) (printer x wr out)))
-          ((null? x) (display "()" out))
-          ((char? x) (display "#\\" out) (write-char x out))
-          ((symbol? x) (write x out))
-          ((number? x) (display (number->string x) out))
-          ((eq? x #t) (display "#t" out))
-          ((eq? x #f) (display "#f" out))
-          (else
-           ;; (display "#<unknown>" out)
-           (write x out))))))))
+      (define (wr-one x shared?)
+        (cond
+         ((pair? x)
+          (display "(" out)
+          (wr (car x))
+          (let lp ((ls (cdr x)))
+            (check-shared
+             ls
+             " . "
+             (lambda (ls shared?)
+               (cond ((null? ls))
+                     ((pair? ls)
+                      (cond
+                       (shared?
+                        (display "(" out)
+                        (wr (car ls))
+                        (check-shared
+                         (cdr ls)
+                         " . "
+                         (lambda (ls shared?) (lp ls)))
+                        (display ")" out))
+                       (else
+                        (display " " out)
+                        (wr (car ls))
+                        (lp (cdr ls)))))
+                     (shared?  ;; shared dotted tail
+                      (wr-one ls #f))
+                     (else
+                      (display " . " out)
+                      (wr ls))))))
+          (display ")" out))
+         ((vector? x)
+          (display "#(" out)
+          (let ((len (vector-length x)))
+            (cond ((> len 0)
+                   (wr (vector-ref x 0))
+                   (do ((i 1 (+ i 1)))
+                       ((= i len))
+                     (display " " out)
+                     (wr (vector-ref x i))))))
+          (display ")" out))
+         ((let ((type (type-of x)))
+            (and (type? type) (type-printer type)))
+          => (lambda (printer) (printer x wr out)))
+         ((null? x) (display "()" out))
+         ((char? x) (display "#\\" out) (write-char x out))
+         ((symbol? x) (write x out))
+         ((number? x) (display (number->string x) out))
+         ((eq? x #t) (display "#t" out))
+         ((eq? x #f) (display "#f" out))
+         (else
+          ;; (display "#<unknown>" out)
+          (write x out))))
+      (check-shared x "" wr-one))))
 
 (define write/ss write-with-shared-structure)
 
diff --git a/lib/srfi/38/test.sld b/lib/srfi/38/test.sld
index 6da58482..33d7ac28 100644
--- a/lib/srfi/38/test.sld
+++ b/lib/srfi/38/test.sld
@@ -21,7 +21,7 @@
 
       (define-syntax test-cyclic-io
         (syntax-rules ()
-          ((test-io str-expr expr)
+          ((test-cyclic-io str-expr expr)
            (let ((str str-expr)
                  (value expr))
              (test str (write-to-string value #t))
@@ -48,6 +48,13 @@
       (test-io "(#0=(1 . 2) #1=(1 . 2) #2=(3 . 4) #0# #1# #2#)"
                (let ((a (cons 1 2)) (b (cons 1 2)) (c (cons 3 4)))
                  (list a b c a b c)))
+      (test-io "((1 . #0=#(2)) #0#)"
+               (let ((vec (vector 2)))
+                 (list (cons 1 vec) vec)))
+      (test-io "((1 . #0=#(2 #0#)) #0#)"
+               (let ((vec (vector 2 #f)))
+                 (vector-set! vec 1 vec)
+                 (list (cons 1 vec) vec)))
       (test-cyclic-io "((1 . 2) (1 . 2) (3 . 4) (1 . 2) (1 . 2) (3 . 4))"
                       (let ((a (cons 1 2)) (b (cons 1 2)) (c (cons 3 4)))
                         (list a b c a b c)))