Pretty-printed gensyms:

* print-gensym now accepts the symbol "pretty" as a valid
    argument.
  * The writer prints #:pretty-name if the print-gensym value
    is |pretty|.
  * The reader accepts #:id as a valid syntax.  The result is
    a fresh gensym with id as a pretty-name.

src/libcore.ss

@@ -1613,8 +1613,8 @@ reference-implementation:
   (make-parameter
     #t
     (lambda (x)
-      (unless (boolean? x) 
+      (unless (or (boolean? x) (eq? x 'pretty))
-        (error 'print-gensym "~s is not a boolean" x))
+        (error 'print-gensym "~s is not in #t|#f|pretty" x))
       x)))
 
 ;; X (primitive-set! 'make-hash-table

src/libtokenizer.ss

@@ -351,6 +351,20 @@
                (cons 'datum (eof-object)))))]
         [(digit? c) 
          (tokenize-hashnum p (char->num c))]
+        [($char= #\: c)
+         (let* ([c (skip-whitespace p "gensym")]
+                [id0 
+                 (cond
+                   [(initial? c)
+                    (list->string
+                      (reverse (tokenize-identifier (cons c '()) p)))]
+                   [($char= #\| c)
+                    (list->string 
+                      (reverse (tokenize-bar p '())))]
+                   [else 
+                    (error 'tokenize
+                      "invalid char ~a inside gensym" c)])])
+              (cons 'datum (gensym id0)))]
         [($char= #\{ c)
          (let* ([c (skip-whitespace p "gensym")]
                 [id0 

src/libwriter.ss

@@ -135,17 +135,27 @@
   (define write-gensym
     (lambda (x p m h i)
       (cond
-        [(and m (print-gensym))
+        [(and m (print-gensym)) =>
-         (let ([str (symbol->string x)])
+         (lambda (gensym-how)
-           (write-char #\# p)
+           (case gensym-how
-           (write-char #\{ p)
+             [(pretty)
-           (if (valid-symbol-string? str)
+              (let ([str (symbol->string x)])
-               (write-char* str p)
+                (write-char #\# p)
-               (write-symbol-esc str p))
+                (write-char #\: p)
-           (write-char #\space p)
+                (if (valid-symbol-string? str)
-           (write-symbol-esc (gensym->unique-string x) p)
+                    (write-char* str p)
-           (write-char #\} p))
+                    (write-symbol-esc str p)))]
-         i]
+             [else
+              (let ([str (symbol->string x)])
+                (write-char #\# p)
+                (write-char #\{ p)
+                (if (valid-symbol-string? str)
+                    (write-char* str p)
+                    (write-symbol-esc str p))
+                (write-char #\space p)
+                (write-symbol-esc (gensym->unique-string x) p)
+                (write-char #\} p))])
+           i)]
         [else 
          (write-symbol x p m)
          i])))