From 9fdfbb934d4d0c8ca232b801e3d0165e46db8b12 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.

original commit: 70e1d63bed2ac85313d048cc9c359ae43330a7e3
---
 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 4ca4de52..9161ef79 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 c8c78613..f7cd1ab9 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 f0662ffc..3fd5cf9f 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.}