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

Add vars to tvar environment when infering poly function applications.

Browse Source
This commit is contained in:
Eric Dobson 2014-06-14 14:00:14 -07:00
parent 3df3cd2b9d
commit f47159be46
2 changed files with 26 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
View File

@ -3,6 +3,7 @@
(require (rename-in "../utils/utils.rkt" [infer r:infer]) (require (rename-in "../utils/utils.rkt" [infer r:infer])
racket/match syntax/stx racket/match syntax/stx
(prefix-in c: (contract-req)) (prefix-in c: (contract-req))
(env tvar-env)
(for-syntax syntax/parse racket/base) (for-syntax syntax/parse racket/base)
(types utils union subtype resolve abbrev (types utils union subtype resolve abbrev
substitute classes) substitute classes)
@ -78,17 +79,18 @@
;; in filters/objects). Note that we have to use argtys-t here, since ;; in filters/objects). Note that we have to use argtys-t here, since
;; argtys is a list of tc-results. ;; argtys is a list of tc-results.
(λ (dom rng rest drest a) (λ (dom rng rest drest a)
(cond (extend-tvars vars
[drest (cond
(infer/dots [drest
fixed-vars dotted-var argtys-t dom (car drest) rng (fv rng) (infer/dots
#:expected (and expected (tc-results->values expected)))] fixed-vars dotted-var argtys-t dom (car drest) rng (fv rng)
[rest #:expected (and expected (tc-results->values expected)))]
(infer/vararg fixed-vars (list dotted-var) argtys-t dom rest rng [rest
(and expected (tc-results->values expected)))] (infer/vararg fixed-vars (list dotted-var) argtys-t dom rest rng
;; no rest or drest (and expected (tc-results->values expected)))]
[else (infer fixed-vars (list dotted-var) argtys-t dom rng ;; no rest or drest
(and expected (tc-results->values expected)))])) [else (infer fixed-vars (list dotted-var) argtys-t dom rng
(and expected (tc-results->values expected)))])))
t argtys expected)] t argtys expected)]
;; regular polymorphic functions without dotted rest, ;; regular polymorphic functions without dotted rest,
;; we do not choose any instantiations with mandatory keyword arguments ;; we do not choose any instantiations with mandatory keyword arguments
@ -109,8 +111,9 @@
;; in filters/objects). Note that we have to use argtys-t here, since ;; in filters/objects). Note that we have to use argtys-t here, since
;; argtys is a list of tc-results. ;; argtys is a list of tc-results.
(λ (dom rng rest kw? a) (λ (dom rng rest kw? a)
(infer/vararg vars null argtys-t dom rest rng (extend-tvars vars
(and expected (tc-results->values expected)))) (infer/vararg vars null argtys-t dom rest rng
(and expected (tc-results->values expected)))))
t argtys expected)] t argtys expected)]
;; Row polymorphism. For now we do really dumb inference that only works ;; Row polymorphism. For now we do really dumb inference that only works
;; in very restricted cases, but is probably enough for most cases in ;; in very restricted cases, but is probably enough for most cases in

10
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/poly-dots.rkt Normal file
View File

@ -0,0 +1,10 @@
#lang typed/scheme/base
(: map-with-funcs (All (b ...) ((List (b ... b -> b) ... b ) -> (b ... b -> (values b ... b)))))
(define (map-with-funcs fs)
(lambda bs
(apply values (map (plambda: (c) ([f : (b ... b -> c)])
(apply f bs)) fs))))
(map-with-funcs (list + - /))