Only generate poly contracts for functions
Closes PR 13815
(cherry picked from commit bafaf52056
)
This commit is contained in:
parent
90b149dc46
commit
a18bf85b4f
6
collects/tests/typed-racket/fail/pr13815.rkt
Normal file
6
collects/tests/typed-racket/fail/pr13815.rkt
Normal file
|
@ -0,0 +1,6 @@
|
||||||
|
#;
|
||||||
|
(exn:pred #rx"Type (All (a) Flonum) could not be converted to a contract")
|
||||||
|
#lang typed/racket
|
||||||
|
(require/typed racket/base [list (All (a) Float)])
|
||||||
|
(* 3.3 list)
|
||||||
|
|
|
@ -21,7 +21,13 @@
|
||||||
(t (-Number . -> . -Number))
|
(t (-Number . -> . -Number))
|
||||||
(t (-Promise -Number))
|
(t (-Promise -Number))
|
||||||
(t (-set Univ))
|
(t (-set Univ))
|
||||||
))
|
;; Adapted from PR 13815
|
||||||
|
(t (-poly (a) (-> a a)))
|
||||||
|
(t (-poly (a) (-mu X (-> a X))))
|
||||||
|
(t (-poly (a) (-poly (b) (-> a a))))
|
||||||
|
(t (-poly (a) (-App (-poly (b) (-> a a)) (list -Number) #'#f)))
|
||||||
|
(t/fail (-poly (a) -Flonum))
|
||||||
|
(t/fail (-poly (a) (-set -Number)))))
|
||||||
|
|
||||||
(define-go contract-tests)
|
(define-go contract-tests)
|
||||||
(provide contract-tests)
|
(provide contract-tests)
|
||||||
|
|
|
@ -375,6 +375,17 @@
|
||||||
[(F: v) (cond [(assoc v (vars)) => second]
|
[(F: v) (cond [(assoc v (vars)) => second]
|
||||||
[else (int-err "unknown var: ~a" v)])]
|
[else (int-err "unknown var: ~a" v)])]
|
||||||
[(Poly: vs b)
|
[(Poly: vs b)
|
||||||
|
;; Don't generate poly contracts for non-functions
|
||||||
|
(define function-type?
|
||||||
|
(let loop ([ty ty])
|
||||||
|
(match (resolve ty)
|
||||||
|
[(Function: _) #t]
|
||||||
|
[(Union: elems) (andmap loop elems)]
|
||||||
|
[(Poly: _ body) (loop body)]
|
||||||
|
[(PolyDots: _ body) (loop body)]
|
||||||
|
[_ #f])))
|
||||||
|
(unless function-type?
|
||||||
|
(exit (fail)))
|
||||||
(if (not (from-untyped? typed-side))
|
(if (not (from-untyped? typed-side))
|
||||||
;; in typed positions, no checking needed for the variables
|
;; in typed positions, no checking needed for the variables
|
||||||
(parameterize ([vars (append (for/list ([v (in-list vs)]) (list v #'any/c)) (vars))])
|
(parameterize ([vars (append (for/list ([v (in-list vs)]) (list v #'any/c)) (vars))])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user