Only generate poly contracts for functions

Closes PR 13815
(cherry picked from commit bafaf52056)
This commit is contained in:
Asumu Takikawa 2013-06-11 20:44:21 -04:00 committed by Ryan Culpepper
parent 90b149dc46
commit a18bf85b4f
3 changed files with 24 additions and 1 deletions

View 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)

View File

@ -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)

View File

@ -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))])