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

Remove an unnecessary syntax-parse expression

Browse Source 
Not sure why this was there
This commit is contained in:
Asumu Takikawa 2014-11-05 17:03:52 -05:00
parent 8137163b7f
commit c51a87dc36
1 changed files with 50 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -79,55 +79,53 @@
;; for looking up types in the optimizer. ;; for looking up types in the optimizer.
[(transformed-body ...) [(transformed-body ...)
(change-contract-fixups (flatten-all-begins #'(begin optimized-body ...)))]) (change-contract-fixups (flatten-all-begins #'(begin optimized-body ...)))])
(syntax-parse body2 (define ty-str
[_ (let ([ty-str (match type (match type
;; 'no-type means the form is not an expression and ;; 'no-type means the form is not an expression and
;; has no meaningful type to print ;; has no meaningful type to print
['no-type #f] ['no-type #f]
;; don't print results of type void ;; don't print results of type void
[(tc-result1: (== -Void type-equal?)) [(tc-result1: (== -Void type-equal?)) #f]
#f] ;; don't print results of unknown type
;; don't print results of unknown type [(tc-any-results: f) #f]
[(tc-any-results: f) [(tc-result1: t f o)
#f] ;; Don't display the whole types at the REPL. Some case-lambda types
[(tc-result1: t f o) ;; are just too large to print.
;; Don't display the whole types at the REPL. Some case-lambda types ;; Also, to avoid showing too precise types, we generalize types
;; are just too large to print. ;; before printing them.
;; Also, to avoid showing too precise types, we generalize types (define tc (cleanup-type t))
;; before printing them. (define tg (generalize tc))
(define tc (cleanup-type t)) (format "- : ~a~a~a\n"
(define tg (generalize tc)) (pretty-format-type tg #:indent 4)
(format "- : ~a~a~a\n" (cond [(equal? tc tg) ""]
(pretty-format-type tg #:indent 4) [else (format " [more precisely: ~a]" tc)])
(cond [(equal? tc tg) ""] (cond [(equal? tc t) ""]
[else (format " [more precisely: ~a]" tc)]) [did-I-suggest-:print-type-already? " ..."]
(cond [(equal? tc t) ""] [else (set! did-I-suggest-:print-type-already? #t)
[did-I-suggest-:print-type-already? " ..."] :print-type-message]))]
[else (set! did-I-suggest-:print-type-already? #t) [(tc-results: t)
:print-type-message]))] (define tcs (map cleanup-type t))
[(tc-results: t) (define tgs (map generalize tcs))
(define tcs (map cleanup-type t)) (define tgs-val (make-Values (map -result tgs)))
(define tgs (map generalize tcs)) (define formatted (pretty-format-type tgs-val #:indent 4))
(define tgs-val (make-Values (map -result tgs))) (define indented? (regexp-match? #rx"\n" formatted))
(define formatted (pretty-format-type tgs-val #:indent 4)) (format "- : ~a~a~a\n"
(define indented? (regexp-match? #rx"\n" formatted)) formatted
(format "- : ~a~a~a\n" (cond [(andmap equal? tgs tcs) ""]
formatted [indented?
(cond [(andmap equal? tgs tcs) ""] (format "\n[more precisely: ~a]"
[indented? (pretty-format-type (make-Values tcs) #:indent 17))]
(format "\n[more precisely: ~a]" [else (format " [more precisely: ~a]" (cons 'Values tcs))])
(pretty-format-type (make-Values tcs) #:indent 17))] ;; did any get pruned?
[else (format " [more precisely: ~a]" (cons 'Values tcs))]) (cond [(andmap equal? t tcs) ""]
;; did any get pruned? [did-I-suggest-:print-type-already? " ..."]
(cond [(andmap equal? t tcs) ""] [else (set! did-I-suggest-:print-type-already? #t)
[did-I-suggest-:print-type-already? " ..."] :print-type-message]))]
[else (set! did-I-suggest-:print-type-already? #t) [x (int-err "bad type result: ~a" x)]))
:print-type-message]))] (if ty-str
[x (int-err "bad type result: ~a" x)])]) #`(begin (display '#,ty-str)
(if ty-str #,(if (unbox include-extra-requires?)
#`(begin (display '#,ty-str) extra-requires
#,(if (unbox include-extra-requires?) #'(begin))
extra-requires #,(arm #'(begin transformed-body ...)))
#'(begin)) (arm #'(begin transformed-body ...))))))]))
#,(arm #'(begin transformed-body ...)))
(arm #'(begin transformed-body ...))))]))))]))