From 74b6ccbf6a8f8669ca0806f4bb72766e672c68a3 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 14 Aug 2012 09:56:49 -0400
Subject: [PATCH] Minor printer refactoring.

original commit: fddd5c63ff4113c104dd184b90b38900aa99b4ad
---
 collects/typed-racket/types/printer.rkt | 75 ++++++++++++-------------
 1 file changed, 37 insertions(+), 38 deletions(-)

diff --git a/collects/typed-racket/types/printer.rkt b/collects/typed-racket/types/printer.rkt
index cf0469b9..2f914c74 100644
--- a/collects/typed-racket/types/printer.rkt
+++ b/collects/typed-racket/types/printer.rkt
@@ -6,20 +6,19 @@
                   "rep/rep-utils.rkt" "types/abbrev.rkt" "types/subtype.rkt"
                   "utils/utils.rkt"
                   "utils/tc-utils.rkt")
-         (for-syntax racket/base))
+         (for-syntax racket/base syntax/parse))
 
 ;; printer-type: (one-of/c 'custom 'debug)
 (define-for-syntax printer-type 'custom)
 
-(define-syntax (make-provides stx)
+(define-syntax (provide-printer stx)
   (if (eq? printer-type 'debug)
-      #'(provide (rename-out
-                   (debug-printer print-type)
-                   (debug-printer print-filter)
-                   (debug-printer print-object)
-                   (debug-printer print-pathelem)))
+      #'(provide (rename-out [debug-printer print-type]
+                             [debug-printer print-filter]
+                             [debug-printer print-object]
+                             [debug-printer print-pathelem]))
       #'(provide print-type print-filter print-object print-pathelem)))
-(make-provides)
+(provide-printer)
 
 (provide print-multi-line-case-> special-dots-printing? print-complex-filters?)
 
@@ -325,35 +324,35 @@
 
 
 
-(define-syntax (make-debug-printer stx)
-  (syntax-local-introduce
-    (if (eq? printer-type 'debug)
-      #'(begin
-          (require racket/pretty)
-          (require mzlib/pconvert)
+(define-syntax (define-debug-printer stx)
+  (syntax-parse stx
+    [(_ debug-printer:id)
+     #:when (eq? printer-type 'debug)
+     #'(begin
+         (require racket/pretty)
+         (require mzlib/pconvert)
+         
+         (define (converter v basic sub)
+           (define (gen-constructor sym)
+             (string->symbol (string-append "make-" (substring (symbol->string sym) 7))))
+           (match v
+             [(? (lambda (e) (or (Filter? e)
+                                 (Object? e)
+                                 (PathElem? e)))
+                 (app (lambda (v) (vector->list (struct->vector v)))
+                      (list-rest tag seq fv fi stx vals)))
+              `(,(gen-constructor tag) ,@(map sub vals))]
+             [(? Type?
+                 (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx key vals)))
+              `(,(gen-constructor tag) ,@(map sub vals))]
+             [_ (basic v)]))
+         
+         (define (debug-printer v port write?)
+           ((if write? pretty-write pretty-print)
+            (parameterize ((current-print-convert-hook converter))
+              (print-convert v))
+            port)))]
+    [_ #'(begin)]))
 
-          (define (converter v basic sub)
-            (define (gen-constructor sym)
-              (string->symbol (string-append "make-" (substring (symbol->string sym) 7))))
-            (match v
-              [(? (lambda (e) (or (Filter? e)
-                                  (Object? e)
-                                  (PathElem? e)))
-                  (app (lambda (v) (vector->list (struct->vector v)))
-                       (list-rest tag seq fv fi stx vals)))
-               `(,(gen-constructor tag) ,@(map sub vals))]
-              [(? Type?
-                  (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx key vals)))
-               `(,(gen-constructor tag) ,@(map sub vals))]
-              [_ (basic v)]))
-
-          (define (debug-printer v port write?)
-            ((if write?
-                 pretty-write
-                 pretty-print)
-             (parameterize ((current-print-convert-hook converter))
-               (print-convert v))
-             port)))
-      #'(begin))))
-(make-debug-printer)
+(define-debug-printer debug-printer)