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

Use type pretty-printing in TR messages

Browse Source 
Closes PR 11271

original commit: 130f6673903b72a7813c357405acb85ee886dc37
This commit is contained in:
Asumu Takikawa 2014-01-06 17:49:48 -05:00
parent ee191531e6
commit e640308b0e
3 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/top-interaction.rkt
View File

@ -81,10 +81,11 @@
(λ (expanded type)
#`(display
#,(parameterize ([print-multi-line-case-> #t])
(format "~a\n" (match type
[(tc-result1: t f o) t]
[(tc-results: t) (-values t)]
[(tc-any-results:) ManyUniv]))))))]
(pretty-format-type
(match type
[(tc-result1: t f o) t]
[(tc-results: t) (-values t)]
[(tc-any-results:) ManyUniv]))))))]
[form
(raise-syntax-error #f "must be applied to exactly one argument" #'form)]))

11
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt
View File

@ -11,6 +11,7 @@
(rep type-rep)
(for-template (base-env top-interaction))
(utils utils tc-utils arm)
(only-in (types printer) pretty-format-type)
"standard-inits.rkt"
"tc-setup.rkt")
@ -82,7 +83,7 @@
(define tc (cleanup-type t))
(define tg (generalize tc))
(format "- : ~a~a~a\n"
tg
(pretty-format-type tg #:indent 4)
(cond [(equal? tc tg) ""]
[else (format " [more precisely: ~a]" tc)])
(cond [(equal? tc t) ""]
@ -92,9 +93,15 @@
[(tc-results: t)
(define tcs (map cleanup-type t))
(define tgs (map generalize tcs))
(define tgs-val (make-Values tgs))
(define formatted (pretty-format-type tgs-val #:indent 4))
(define indented? (regexp-match? #rx"\n" formatted))
(format "- : ~a~a~a\n"
(cons 'Values tgs)
formatted
(cond [(andmap equal? tgs tcs) ""]
[indented?
(format "\n[more precisely: ~a]"
(pretty-format-type (make-Values tcs) #:indent 17))]
[else (format " [more precisely: ~a]" (cons 'Values tcs))])
;; did any get pruned?
(cond [(andmap equal? t tcs) ""]

7
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt
View File

@ -4,7 +4,8 @@
racket/match (prefix-in - (contract-req))
(types utils union subtype filter-ops)
(utils tc-utils)
(rep type-rep object-rep filter-rep))
(rep type-rep object-rep filter-rep)
(only-in (types printer) pretty-format-type))
(provide/cond-contract
[check-below (-->d ([s (-or/c Type/c tc-results/c)] [t (-or/c Type/c tc-results/c)]) ()
@ -46,7 +47,9 @@
(type-mismatch (format "`~a'" t1) (format "a different `~a'" t2)
"type variables bound in different scopes")]
[(_ _)
(type-mismatch t1 t2)]))
(type-mismatch
(if (Type/c? t1) (pretty-format-type t1 #:indent 12) t1)
(if (Type/c? t2) (pretty-format-type t2 #:indent 9) t2))]))
;; check-below : (/\ (Results Type -> Result)
;; (Results Results -> Result)