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

Generalize types shown at the REPL, to keep types simple.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-09-13 13:49:04 -04:00
parent 386d3f4e1f
commit 68d58f7d2a
1 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -88,19 +88,27 @@
[(tc-result1: t f o) [(tc-result1: t f o)
;; Don't display the whole types at the REPL. Some case-lambda types ;; Don't display the whole types at the REPL. Some case-lambda types
;; are just too large to print. ;; are just too large to print.
(let ([tc (cleanup-type t)]) ;; Also, to avoid showing too precise types, we generalize types
(format "- : ~a~a\n" ;; before printing them.
tc (define tc (cleanup-type t))
(define tg (generalize tc))
(format "- : ~a~a~a\n"
tg
(cond [(equal? tc tg) ""]
[else (format " (generalized from ~a)" tc)])
(cond [(equal? tc t) ""] (cond [(equal? tc t) ""]
[did-I-suggest-:print-type-already? " ..."] [did-I-suggest-:print-type-already? " ..."]
[else (set! did-I-suggest-:print-type-already? #t) [else (set! did-I-suggest-:print-type-already? #t)
:print-type-message])))] :print-type-message]))]
[(tc-results: t) [(tc-results: t)
(define new-ts (map cleanup-type t)) (define tcs (map cleanup-type t))
(format "- : ~a~a\n" (define tgs (map generalize tcs))
(cons 'Values new-ts) (format "- : ~a~a~a\n"
(cons 'Values tgs)
(cond [(andmap equal? tgs tcs) ""]
[else (format " (generalized from ~a)" (cons 'Values tcs))])
;; did any get pruned? ;; did any get pruned?
(cond [(andmap equal? t new-ts) ""] (cond [(andmap equal? t tcs) ""]
[did-I-suggest-:print-type-already? " ..."] [did-I-suggest-:print-type-already? " ..."]
[else (set! did-I-suggest-:print-type-already? #t) [else (set! did-I-suggest-:print-type-already? #t)
:print-type-message]))] :print-type-message]))]