From 1e1fb40d3252cdc4e6f195dffd125557372f4a2b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 6 Aug 2012 18:26:27 -0400
Subject: [PATCH] Allow multi-line printing of case-> types.

Currently only used in :print-type. Everywhere else, types are pruned.

original commit: 4b30d052b0216420ef1abcec44f0c027cc588880
---
 collects/typed-racket/core.rkt          | 9 +++++----
 collects/typed-racket/types/printer.rkt | 5 +++--
 collects/typed-racket/utils/utils.rkt   | 3 ++-
 3 files changed, 10 insertions(+), 7 deletions(-)

diff --git a/collects/typed-racket/core.rkt b/collects/typed-racket/core.rkt
index 66cb9574..985ec2d8 100644
--- a/collects/typed-racket/core.rkt
+++ b/collects/typed-racket/core.rkt
@@ -56,10 +56,11 @@
     ;; Prints the _entire_ type. May be quite large.
     [(_ . ((~literal :print-type) e:expr))
      #`(display #,(tc-setup #'stx #'e 'top-level expanded init tc-toplevel-form before type
-                            (format "~a\n"
-                                    (match type
-                                      [(tc-result1: t f o) t]
-                                      [(tc-results: t) (cons 'Values t)]))))]
+                            (parameterize ([print-multi-line-case-> #t])
+                              (format "~a\n"
+                                      (match type
+                                        [(tc-result1: t f o) t]
+                                        [(tc-results: t) (cons 'Values t)])))))]
     ;; given a function and a desired return type, fill in the blanks
     [(_ . ((~literal :query-result-type) op:expr desired-type:expr))
      (let ([expected (parse-type #'desired-type)])
diff --git a/collects/typed-racket/types/printer.rkt b/collects/typed-racket/types/printer.rkt
index 0fea0d5a..32a09b83 100644
--- a/collects/typed-racket/types/printer.rkt
+++ b/collects/typed-racket/types/printer.rkt
@@ -172,9 +172,10 @@
          [(list) "(case->)"]
          [(list a) (format-arr a)]
          [(list a b ...)
-          (format "(case-> ~a ~a)"
+          (define multi-line? (print-multi-line-case->))
+          (format (string-append "(case-> ~a" (if multi-line? "\n        " " ") "~a)")
                   (format-arr a)
-                  (string-join (map format-arr b)))]))]))
+                  (string-join (map format-arr b) (if multi-line? "\n        " " ")))]))]))
 
 ;; print out a type
 ;; print-type : Type Port Boolean -> Void
diff --git a/collects/typed-racket/utils/utils.rkt b/collects/typed-racket/utils/utils.rkt
index 0301654e..92fd2256 100644
--- a/collects/typed-racket/utils/utils.rkt
+++ b/collects/typed-racket/utils/utils.rkt
@@ -20,7 +20,7 @@ at least theoretically.
  ;; logging
  printf/log show-input?
  ;; struct printing
- custom-printer define-struct/printer
+ custom-printer print-multi-line-case-> define-struct/printer
  ;; provide macros
  rep utils typecheck infer env private types)
 
@@ -123,6 +123,7 @@ at least theoretically.
   print-pathelem*)
 
 (define custom-printer (make-parameter #t))
+(define print-multi-line-case-> (make-parameter #f))
 
 (define-syntax (define-struct/printer stx)
   (syntax-parse stx