From 19c5d3eaadb3a25e99684a553e8facbb05e20946 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Tue, 21 May 2013 09:31:23 -0400 Subject: [PATCH] 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. --- .../succeed/type-printer-single-level.rkt | 6 ++-- collects/typed-racket/core.rkt | 14 ++++++-- collects/typed-racket/types/printer.rkt | 32 +++++++++++++------ 3 files changed, 38 insertions(+), 14 deletions(-) diff --git a/collects/tests/typed-racket/succeed/type-printer-single-level.rkt b/collects/tests/typed-racket/succeed/type-printer-single-level.rkt index 9bc5d19b04..cc4e3421dd 100644 --- a/collects/tests/typed-racket/succeed/type-printer-single-level.rkt +++ b/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) " diff --git a/collects/typed-racket/core.rkt b/collects/typed-racket/core.rkt index 34cf8f1e17..c5b8d131ca 100644 --- a/collects/typed-racket/core.rkt +++ b/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))]) - #`(display #,(format "~a\n" (parse-type #'ty))))] + (if (attribute verbose-kw) '() (current-type-names))] + [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 diff --git a/collects/typed-racket/types/printer.rkt b/collects/typed-racket/types/printer.rkt index 52f7c4b175..032cd2ec8f 100644 --- a/collects/typed-racket/types/printer.rkt +++ b/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] (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) - (parameterize ([current-print-type-fuel (sub1 fuel)]) - ;; if we still have fuel, print the expanded type and - ;; add the name to the ignored list so that the union - ;; printer does not try to print with the name. - (print-type type port write? (append names ignored-names))) - (fp "~a" (car names)))] + (cond [(> fuel 0) + (parameterize ([current-print-type-fuel (sub1 fuel)]) + ;; if we still have fuel, print the expanded type and + ;; add the name to the ignored list so that the union + ;; printer does not try to print with the name. + (print-type type port write? (append names ignored-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")]