diff --git a/src/ikarus.boot b/src/ikarus.boot
index bdae43d..d4e2d8e 100644
Binary files a/src/ikarus.boot and b/src/ikarus.boot differ
diff --git a/src/ikarus.pretty-print.ss b/src/ikarus.pretty-print.ss
index 40409cf..c2deacb 100644
--- a/src/ikarus.pretty-print.ss
+++ b/src/ikarus.pretty-print.ss
@@ -198,6 +198,12 @@
       [(vector? x)    (boxify-vector x)]
       [(list? x)      (boxify-list x '())]
       [(pair? x)      (boxify-pair x)]
+      [(setbox? x) 
+       (let ([i (format "#~a=" (setbox-idx x))]
+             [b (boxify (setbox-data x))])
+         (make-cbox (+ (string-length i) (box-length b))
+           (list i b)))]
+      [(refbox? x) (format "#~a#" (refbox-idx x))]
       [else           (format "~s" x)]))
   (define string-esc-table
     '((7 . "a")
@@ -433,9 +439,141 @@
     (f x p 0)
     (newline p))
   ;;;
+
+  (define (hasher x h)
+    (define (vec-graph x i j)
+      (unless (fx= i j)
+        (graph (vector-ref x i))
+        (vec-graph x (fxadd1 i) j h)))
+    (define (vec-dynamic x i j)
+      (unless (fx= i j)
+        (dynamic (vector-ref x i))
+        (vec-dynamic x (fxadd1 i) j)))
+    (define rv #f)
+    (define (graph x)
+      (cond
+        [(pair? x)
+         (cond
+           [(get-hash-table h x #f) =>
+            (lambda (n)
+              (set! rv #t)
+              (put-hash-table! h x (fxadd1 n)))]
+           [else
+            (put-hash-table! h x 0)
+            (graph (car x))
+            (graph (cdr x))])]
+        [(vector? x)
+         (cond
+           [(get-hash-table h x #f) =>
+            (lambda (n)
+              (set! rv #t)
+              (put-hash-table! h x (fxadd1 n)))]
+           [else
+            (put-hash-table! h x 0)
+            (vec-graph x 0 (vector-length x))])]
+        [(gensym? x)
+         (cond
+           [(get-hash-table h x #f) =>
+            (lambda (n)
+              (set! rv #t)
+              (put-hash-table! h x (fxadd1 n)))])]))
+    (define (dynamic x)
+      (cond
+        [(pair? x)
+         (cond
+           [(get-hash-table h x #f) =>
+            (lambda (n)
+              (set! rv #t)
+              (put-hash-table! h x (fxadd1 n)))]
+           [else
+            (put-hash-table! h x 0)
+            (dynamic (car x))
+            (dynamic (cdr x))
+            (when (and (get-hash-table h x #f)
+                       (fxzero? (get-hash-table h x #f)))
+              (put-hash-table! h x #f))])]
+        [(vector? x)
+         (cond
+           [(get-hash-table h x #f) =>
+            (lambda (n)
+              (set! rv #t)
+              (put-hash-table! h x (fxadd1 n)))]
+           [else
+            (put-hash-table! h x 0)
+            (vec-dynamic x 0 (vector-length x))
+            (when (and (get-hash-table h x #f)
+                       (fxzero? (get-hash-table h x #f)))
+              (put-hash-table! h x #f))])])) 
+    (if (print-graph) 
+        (graph x)
+        (dynamic x))
+    rv)
+
+  (define-record setbox (idx data))
+  (define-record refbox (idx))
+
+  (define (rewrite-shared x h)
+    (define counter 0)
+    (let f ([x x])
+      (cond
+        [(pair? x) 
+         (cond
+           [(get-hash-table h x #f) =>
+            (lambda (n) 
+              (cond
+                [(setbox? n)
+                 (make-refbox (setbox-idx n))] 
+                [(and (fixnum? n) (fx> n 0))
+                 (let ([box (make-setbox counter #f)])
+                   (set! counter (add1 counter))
+                   (put-hash-table! h x box)
+                   (let* ([a (f (car x))]
+                          [d (f (cdr x))])
+                     (set-setbox-data! box (cons a d))
+                     box))]
+                [else
+                 (let* ([a (f (car x))]
+                        [d (f (cdr x))])
+                   (if (and (eq? a (car x))
+                            (eq? d (cdr x)))
+                       x
+                       (cons a d)))]))]
+           [else
+            (let* ([a (f (car x))]
+                   [d (f (cdr x))])
+              (if (and (eq? a (car x))
+                       (eq? d (cdr x)))
+                  x
+                  (cons a d)))])]
+        [(vector? x)
+         (cond
+           [(get-hash-table h x #f) =>
+            (lambda (n) 
+              (cond
+                [(setbox? n)
+                 (make-refbox (setbox-idx n))]
+                [(and (fixnum? n) (fx> n 0))
+                 (let ([box (make-setbox counter #f)])
+                   (set! counter (add1 counter))
+                   (put-hash-table! h x box)
+                   (set-setbox-data! box
+                     (list->vector
+                       (map1ltr f (vector->list x))))
+                   box)]
+                [else 
+                 (list->vector (map1ltr f (vector->list x)))]))]
+           [else
+            (list->vector (map1ltr f (vector->list x)))])]
+        [else x])))
+
+  (define (unshare x) 
+    (let ([h (make-hash-table)])
+      (if (hasher x h)
+          (rewrite-shared x h)
+          x)))
+  ;;;
   (define (pretty x p)
-    (let ([x (boxify x)])
-      (output x p)))
+    (output (boxify (unshare x)) p))
   ;;;
   (define *pretty-format* '*pretty-format*)
   (define (set-fmt! name fmt)
diff --git a/src/ikarus.writer.ss b/src/ikarus.writer.ss
index 8c4e8be..5532c97 100644
--- a/src/ikarus.writer.ss
+++ b/src/ikarus.writer.ss
@@ -1,7 +1,7 @@
 
 (library (ikarus writer)
   (export write display format printf print-error error-handler
-          error print-unicode)
+          error print-unicode print-graph)
   (import 
     (ikarus system $chars)
     (ikarus system $strings)
@@ -12,7 +12,7 @@
     (ikarus system $bytevectors)
     (only (ikarus unicode-data) unicode-printable-char?) 
     (except (ikarus) write display format printf print-error
-            error-handler error print-unicode))
+            error-handler error print-unicode print-graph))
 
   (define print-unicode
     (make-parameter #t))
diff --git a/src/makefile.ss b/src/makefile.ss
index 8075e82..bcd68e1 100755
--- a/src/makefile.ss
+++ b/src/makefile.ss
@@ -588,6 +588,7 @@
     [pretty-print            i]
     [comment-handler         i]
     [print-gensym            i symbols]
+    [print-graph             i]
     [print-unicode           i]
     [char-general-category   i]
     [gensym-count            i symbols]