Cue user about unexpanded type aliases

This tells the user that more type aliases are
available for expansion. For example, (Listof Number)
has the alias Number still unexpanded into the union
that it represents.

collects/tests/typed-racket/succeed/type-printer-single-level.rkt

@@ -20,12 +20,12 @@
 (tr-eval '(:type Foo))
 (tr-eval '(:type Bar))
 
-(check-equal? (get-output-string out) "(U Integer String)\n(Foo -> Foo)\n")
-
 ;; if #:verbose, make sure it's the full type
 (tr-eval '(:type #:verbose Bar))
+
 (check-equal? (get-output-string out)
-              (string-append "(U Integer String)\n(Foo -> Foo)\n"
+              (string-append "(U Integer String)\n[can expand further: String Integer]"
+                             "(Foo -> Foo)\n[can expand further: Foo]"
                              "((U 0 1 Byte-Larger-Than-One Positive-Index-Not-Byte "
                              "Positive-Fixnum-Not-Index Negative-Fixnum "
                              "Positive-Integer-Not-Fixnum Negative-Integer-Not-Fixnum String) "

collects/typed-racket/core.rkt

@@ -6,7 +6,9 @@
          (private with-types type-contract parse-type)
          (except-in syntax/parse id)
          racket/match racket/syntax unstable/match racket/list syntax/stx
+         racket/format
          racket/promise
+         (only-in racket/string string-join)
          (types utils abbrev generalize printer)
          (typecheck provide-handling tc-toplevel tc-app-helper)
          (rep type-rep)
@@ -62,8 +64,16 @@
                     ;; infinite fuel case. If fuel that's not 0, 1, or +inf.0
                     ;; is ever used, more may need to be done.
                     [current-type-names
-                     (if (attribute verbose-kw) '() (current-type-names))])
+                     (if (attribute verbose-kw) '() (current-type-names))]
-       #`(display #,(format "~a\n" (parse-type #'ty))))]
+                    [current-print-unexpanded (box '())])
+       (define type (format "~a" (parse-type #'ty)))
+       (define unexpanded
+         (remove-duplicates (unbox (current-print-unexpanded))))
+       (define cue (if (null? unexpanded)
+                       ""
+                       (format "[can expand further: ~a]"
+                               (string-join (map ~a unexpanded)))))
+       #`(display #,(format "~a\n~a" type cue)))]
     ;; Prints the _entire_ type. May be quite large.
     [(_ . ((~literal :print-type) e:expr))
      (tc-setup #'stx #'e 'top-level expanded init tc-toplevel-form before type

collects/typed-racket/types/printer.rkt

@@ -24,7 +24,7 @@
 (provide-printer)
 
 (provide print-multi-line-case-> special-dots-printing? print-complex-filters?
-         current-print-type-fuel)
+         current-print-type-fuel current-print-unexpanded)
 
 
 ;; do we attempt to find instantiations of polymorphic types to print?
@@ -43,6 +43,10 @@
 ;;    +inf.0 -> expand always
 (define current-print-type-fuel (make-parameter 0))
 
+;; this parameter allows the printer to communicate unexpanded
+;; type aliases to its clients, which is used to cue the user
+(define current-print-unexpanded (make-parameter (box '())))
+
 ;; does t have a type name associated with it currently?
 ;; has-name : Type -> Maybe[Listof<Symbol>]
 (define (has-name? t)
@@ -142,7 +146,13 @@
              [candidates candidates]
              [coverage   '()])
     (cond [(null? to-cover) ; done
-           (append (map car coverage) uncoverable)] ; we want the names
+           (define coverage-names (map car coverage))
+           ;; to allow :type to cue the user on unexpanded aliases
+           (set-box! (current-print-unexpanded)
+                     ;; FIXME: this could be pickier about the names to
+                     ;;        report since, e.g., "String" can't be expanded
+                     (append coverage-names (unbox (current-print-unexpanded))))
+           (append coverage-names uncoverable)] ; we want the names
           [else
            ;; pick the candidate that covers the most uncovered types
            (define (covers-how-many? c)
@@ -249,13 +259,17 @@
      (=> fail)
      (when (not (null? ignored-names)) (fail))
      (define fuel (current-print-type-fuel))
-     (if (> fuel 0)
+     (cond [(> fuel 0)
-         (parameterize ([current-print-type-fuel (sub1 fuel)])
+            (parameterize ([current-print-type-fuel (sub1 fuel)])
-           ;; if we still have fuel, print the expanded type and
+              ;; if we still have fuel, print the expanded type and
-           ;; add the name to the ignored list so that the union
+              ;; add the name to the ignored list so that the union
-           ;; printer does not try to print with the name.
+              ;; printer does not try to print with the name.
-           (print-type type port write? (append names ignored-names)))
+              (print-type type port write? (append names ignored-names)))]
-         (fp "~a" (car names)))]
+           [else
+            ;; to allow :type to cue the user on unexpanded aliases
+            (set-box! (current-print-unexpanded)
+                      (cons (car names) (unbox (current-print-unexpanded))))
+            (fp "~a" (car names))])]
     [(StructType: (Struct: nm _ _ _ _ _)) (fp "(StructType ~a)" (syntax-e nm))]
     [(StructTop: (Struct: nm _ _ _ _ _)) (fp "(Struct ~a)" (syntax-e nm))]
     [(BoxTop:) (fp "Box")]