From 70e1d63bed2ac85313d048cc9c359ae43330a7e3 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 19 Jul 2011 17:27:25 -0400
Subject: [PATCH] Add a function to print whole types.

With this, it's possible to get more information than the simplified
types shown at the REPL. The types are as unwieldy as ever, but you
have to ask for them explicitly.

This is not an adequate long-term solution, and will be replaced by a
"Type Explorer" tool.
---
 collects/typed-scheme/base-env/prims.rkt         | 16 ++++++++++++++--
 collects/typed-scheme/core.rkt                   |  4 ++--
 .../scribblings/reference/experimental.scrbl     |  3 +++
 3 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/base-env/prims.rkt b/collects/typed-scheme/base-env/prims.rkt
index 4ca4de524e..9161ef7907 100644
--- a/collects/typed-scheme/base-env/prims.rkt
+++ b/collects/typed-scheme/base-env/prims.rkt
@@ -37,8 +37,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
          racket/flonum ; for for/flvector and for*/flvector
          mzlib/etc
          (for-syntax
+          racket/match
           syntax/parse
-	  racket/syntax
+          racket/syntax
           racket/base
           racket/struct-info
           syntax/struct
@@ -49,7 +50,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
           "../utils/tc-utils.rkt"
           "../env/type-name-env.rkt"
           "../private/type-contract.rkt"
-          "for-clauses.rkt")
+          "for-clauses.rkt"
+          "../typecheck/tc-toplevel.rkt"
+          "../types/utils.rkt")
          "../types/numeric-predicates.rkt")
 (provide index?) ; useful for assert, and racket doesn't have it
 
@@ -172,6 +175,15 @@ This file defines two sorts of primitives. All of them are provided into any mod
     [(_ ty:expr)
      #`(display #,(format "~a\n" (parse-type #'ty)))]))
 
+;; Prints the _entire_ type. May be quite large.
+(define-syntax (:print-type stx)
+  (syntax-parse stx
+    [(_ e:expr)
+     #`(display #,(format "~a\n"
+                          (match (tc-toplevel-form #'e)
+                            [(tc-result1: t f o) t]
+                            [(tc-results: t) (cons 'Values t)])))]))
+
 (define-syntax (require/opaque-type stx)
   (define-syntax-class name-exists-kw
     (pattern #:name-exists))
diff --git a/collects/typed-scheme/core.rkt b/collects/typed-scheme/core.rkt
index c8c7861342..f7cd1ab93f 100644
--- a/collects/typed-scheme/core.rkt
+++ b/collects/typed-scheme/core.rkt
@@ -73,7 +73,7 @@
                              #f]
                             [(tc-result1: t f o)
                              (let-values ([(t pruned?) (cleanup-type t)])
-                               (format "- : ~a~a\n" t (if pruned? " and more..." "")))]
+                               (format "- : ~a~a\n" t (if pruned? "\nUse :print-type to see more." "")))]
                             [(tc-results: t)
                              ;; map the first component and ormap the second.
                              (define-values (ts any-pruned?)
@@ -84,7 +84,7 @@
                                    (values (cons t ts) (or pruned? new-pruned?)))))
                              (format "- : ~a~a\n"
                                      (cons 'Values (reverse ts))
-                                     (if any-pruned? " and more...\n" ""))]
+                                     (if any-pruned? " \nUse :print-type to see more." ""))]
                             [x (int-err "bad type result: ~a" x)])])
               (if ty-str
                   #`(let ([type '#,ty-str])
diff --git a/collects/typed-scheme/scribblings/reference/experimental.scrbl b/collects/typed-scheme/scribblings/reference/experimental.scrbl
index f0662ffcdc..3fd5cf9f0f 100644
--- a/collects/typed-scheme/scribblings/reference/experimental.scrbl
+++ b/collects/typed-scheme/scribblings/reference/experimental.scrbl
@@ -12,6 +12,9 @@ These features are currently experimental and subject to change.
 
 @defform[(:type t)]{Prints the type @racket[_t].}
 
+@defform[(:print-type e)]{Prints the type of @racket[_e]. This prints the whole
+types, which can sometimes be quite large.}
+
 @defform[(declare-refinement id)]{Declares @racket[id] to be usable in
 refinement types.}