From 5f0717d278343f355f95bbc2ca39d9a3ebbee3dc Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sun, 12 Aug 2012 23:14:53 -0700
Subject: [PATCH] Make disabling the custom printer work.

---
 collects/typed-racket/private/with-types.rkt |  4 +---
 collects/typed-racket/tc-setup.rkt           |  4 +---
 collects/typed-racket/utils/utils.rkt        | 21 ++++++++++----------
 3 files changed, 12 insertions(+), 17 deletions(-)

diff --git a/collects/typed-racket/private/with-types.rkt b/collects/typed-racket/private/with-types.rkt
index 9cdd3c2562..012f0968e0 100644
--- a/collects/typed-racket/private/with-types.rkt
+++ b/collects/typed-racket/private/with-types.rkt
@@ -67,9 +67,7 @@
                       [(id ...) exids]
                       [(ty ...) extys])
           (local-expand #'(let () (begin (: id ty) ... body ... (values id ...))) ctx null))))
-  (parameterize (;; disable fancy printing?
-                 [custom-printer #t]
-                 ;; a cheat to avoid units
+  (parameterize (;; a cheat to avoid units
                  [infer-param infer]
                  ;; do we report multiple errors
                  [delay-errors? #t]
diff --git a/collects/typed-racket/tc-setup.rkt b/collects/typed-racket/tc-setup.rkt
index a466f8806b..4341077cf5 100644
--- a/collects/typed-racket/tc-setup.rkt
+++ b/collects/typed-racket/tc-setup.rkt
@@ -39,9 +39,7 @@
     (with-handlers
         (#;[(λ (e) (and (exn:fail? e) (not (exn:fail:syntax? e)) (not (exn:fail:filesystem? e))))
           (λ (e) (tc-error "Internal Typed Racket Error : ~a" e))])
-      (parameterize (;; enable fancy printing?
-                     [custom-printer #t]
-                     ;; a cheat to avoid units
+      (parameterize (;; a cheat to avoid units
                      [infer-param infer]
                      ;; do we report multiple errors
                      [delay-errors? #t]
diff --git a/collects/typed-racket/utils/utils.rkt b/collects/typed-racket/utils/utils.rkt
index d5c2a289f9..74abbadab5 100644
--- a/collects/typed-racket/utils/utils.rkt
+++ b/collects/typed-racket/utils/utils.rkt
@@ -7,6 +7,7 @@ at least theoretically.
 
 (require (for-syntax racket/base syntax/parse racket/string)
          racket/require-syntax racket/provide-syntax         
+         racket/generic
          racket/struct-info "timing.rkt")
 
 ;; to move to unstable
@@ -20,7 +21,7 @@ at least theoretically.
  ;; logging
  printf/log show-input?
  ;; struct printing
- custom-printer print-multi-line-case-> define-struct/printer
+ print-multi-line-case-> define-struct/printer
  ;; provide macros
  rep utils typecheck infer env private types)
 
@@ -109,7 +110,7 @@ at least theoretically.
       #'(void)))
 
 ;; custom printing
-(define custom-printer (make-parameter #t))
+(define-for-syntax custom-printer #t)
 (define print-multi-line-case-> (make-parameter #f))
 
 (define-syntax (define-struct/printer stx)
@@ -117,15 +118,13 @@ at least theoretically.
     [(form name (flds ...) printer:expr)
      #`(define-struct name (flds ...)
          #:property prop:custom-print-quotable 'never
-         #:property prop:custom-write
-         (lambda (v port write?)
-           (if (custom-printer)
-               (printer v port write?)
-               ;; ok to make this case slow, it never runs in real code
-               ((if write?
-                    (dynamic-require 'racket/pretty 'pretty-write)
-                    (dynamic-require 'racket/pretty 'pretty-print))
-                v port)))
+         ;; Eta expansion so that printer is not evaluated
+         ;; until needed.
+         #,@(if custom-printer
+              #'(#:methods gen:custom-write
+                 [(define (write-proc v port write?)
+                    (printer v port write?))])
+              #'())
          #:transparent)]))