diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt
index 6f73f50..d2800ca 100644
Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ
diff --git a/scheme/ikarus.pretty-print.ss b/scheme/ikarus.pretty-print.ss
index 8c06bb7..e93f27f 100644
--- a/scheme/ikarus.pretty-print.ss
+++ b/scheme/ikarus.pretty-print.ss
@@ -15,10 +15,10 @@
 
 
 (library (ikarus pretty-print)
-  (export pretty-print pretty-width)
+  (export pretty-print pretty-width pretty-format)
   (import 
     (rnrs hashtables)
-    (except (ikarus) pretty-print pretty-width))
+    (except (ikarus) pretty-print pretty-width pretty-format))
   (define (map1ltr f ls)
     ;;; ltr so that gensym counts get assigned properly
     (cond
@@ -609,6 +609,15 @@
        (if (output-port? p)
            (pretty x p)
            (die 'pretty-print "not an output port" p))]))
+
+  (define pretty-format
+    (lambda (x)
+      (unless (symbol? x)
+        (die 'pretty-format "not a symbol" x))
+      (case-lambda
+        [() (getprop x '*pretty-format*)]
+        [(v) (putprop x '*pretty-format* v)])))
+
   ;;; standard formats
   (set-fmt! 'quote '(read-macro . "'"))
   (set-fmt! 'unquote '(read-macro . ","))
diff --git a/scheme/ikarus.writer.ss b/scheme/ikarus.writer.ss
index 954b9a7..184bb88 100644
--- a/scheme/ikarus.writer.ss
+++ b/scheme/ikarus.writer.ss
@@ -449,22 +449,20 @@
   
   (define macro
     (lambda (x h)
-      (define macro-forms
-        '([quote .             "'"]
-          [quasiquote .        "`"]
-          [unquote .           ","]
-          [unquote-splicing .  ",@"]
-          [syntax .            "#'"]
-          [quasisyntax .       "#`"]
-          [unsyntax .          "#,"]
-          [unsyntax-splicing . "#,@"]
-          [|#primitive| .     "#%"]))
-      (and (pair? x)
-           (let ([d ($cdr x)])
-             (and (pair? d)
-                  (null? ($cdr d))
-                  (not (hashtable-ref h x #f))))
-           (assq ($car x) macro-forms))))
+      (and 
+        (pair? x)
+        (let ([a ($car x)])
+          (and
+            (symbol? a)
+            (let ([d ($cdr x)])
+              (and (pair? d)
+                (null? ($cdr d))
+                (not (hashtable-ref h x #f))))
+            (let ([p ((pretty-format a))])
+              (and (pair? p)
+                (eq? (car p) 'read-macro)
+                (string? (cdr p)))
+                p))))))
   
   (define write-pair
     (lambda (x p m h i)
diff --git a/scheme/last-revision b/scheme/last-revision
index 24c937d..bfc0bcc 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1471
+1472
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index bca55f5..1a23bd3 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -1285,6 +1285,7 @@
     [set-symbol-value!                           i symbols $boot]
     [eval-core                                   $boot]
     [pretty-print                                i $boot]
+    [pretty-format                               i]
     [pretty-width                                i]
     [module                                      i cm]
     [library                                     i]