Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions typed-racket-lib/typed-racket/typecheck/signatures.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@
[cond-contracted tc-expr/check/t? (syntax? (or/c tc-results/c #f) . -> . (or/c Type? #f))]
[cond-contracted tc-body/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
[cond-contracted tc-expr/t (syntax? . -> . Type?)]
[cond-contracted tc-expr/t* (syntax? . -> . (values Type? boolean?))]
[cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]
[cond-contracted tc-dep-fun-arg ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))

Expand Down
21 changes: 18 additions & 3 deletions typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
(require "../../utils/utils.rkt"
"signatures.rkt"
"utils.rkt"
syntax/parse syntax/stx racket/match racket/sequence
syntax/parse syntax/stx racket/match
(typecheck signatures tc-funapp error-message)
(types abbrev type-table utils substitute)
(rep type-rep)
Expand Down Expand Up @@ -95,12 +95,18 @@
[else
(expected-but-got t (-Tuple (map tc-expr/t args-list)))
(ret t)])]
[(Listof: t*)
(for ([arg (in-list args-list)])
(tc-expr/check arg (ret t*)))
(add-typeof-expr #'op-name (ret (->* '() t* t)))
(ret t)]
[_
(define vs (map (λ (_) (gensym)) args-list))
(define l-type (-Tuple (map make-F vs)))
;; We want to infer the largest vs that are still under the element types
(define substs (i:infer vs null (list l-type) (list t) (-values (list (-> l-type Univ)))
#:multiple? #t))

(cond
[substs
(define result
Expand All @@ -113,8 +119,17 @@
(add-typeof-expr #'op-name (ret (->* arg-tys return-ty)))
(ret return-ty)))
(or result
(begin (expected-but-got t (-Tuple (map tc-expr/t args-list)))
(fix-results expected)))]
;; When arguments to the list function fail to typecheck, the
;; odds are those argument expressions are ill-typed. In that
;; case, we should only report those type errors instead of the error
;; that the result type of application of list doesn't match
;; the expected one.
(let-values ([(tys errs) (for/lists (tys errs)
([i (in-list args-list)])
(tc-expr/t* i))])
(when (andmap not errs)
(expected-but-got t (-Tuple tys)))
(fix-results expected)))]
[else
(define arg-tys (map tc-expr/t args-list))
(define return-ty (-Tuple arg-tys))
Expand Down
12 changes: 12 additions & 0 deletions typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,18 @@
[(tc-result1: t _ _) t]
[t (int-err "tc-expr returned ~a, not a single tc-result, for ~a" t (syntax->datum e))]))

;; typecheck an expression. The result contains two values
;; 1. the type of the expression
;; 2. whether there are type errors during checking the expression
;;
;; Unlike tc-expr/check/t? and tc-expr/check?, this function raises or keeps errors from
;; checking the expression in the error queue.
;;
;; tc-expr/t* : Expr -> (values Type Boolean)
(define (tc-expr/t* expr)
(parameterize ([current-type-error? #f])
(values (tc-expr/t expr) (current-type-error?))))

(define (tc-expr/check/t e t)
(match (tc-expr/check e t)
[(tc-result1: t) t]))
Expand Down
6 changes: 6 additions & 0 deletions typed-racket-test/unit-tests/typecheck-tests.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -3489,6 +3489,12 @@
#:ret (tc-ret (-seq (-vec Univ)))
#:expected (tc-ret (-seq (-vec Univ)))]

[tc-err
(ann (list (symbol->string "10")) (Listof String))
#:ret (tc-ret (-lst -String))
#:expected (tc-ret (-lst -String))
#:msg #rx"expected: Symbol.*given: String.*"]

;; PR 14557 - apply union of functions with different return values
[tc-err
(let ()
Expand Down