suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Cue user about unexpanded type aliases

Browse Source 
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.
This commit is contained in:
Asumu Takikawa 2013-05-21 09:31:23 -04:00
parent 518c09d52b
commit 19c5d3eaad
3 changed files with 38 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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) "

14
collects/typed-racket/core.rkt
View File

@ -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

32
collects/typed-racket/types/printer.rkt
View File

@ -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)
(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")]