From 687faf6d082d49dda0110b3a3e59e3bc04487ee6 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 7 Oct 2008 21:55:25 +0000 Subject: [PATCH] Fix bug in inference when tvars in env. svn: r11968 original commit: dbf4462228a4094e2fa71617cd88ae61e80e12d2 --- collects/typed-scheme/typecheck/tc-app-unit.ss | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-app-unit.ss b/collects/typed-scheme/typecheck/tc-app-unit.ss index 7b0b0808..88931a18 100644 --- a/collects/typed-scheme/typecheck/tc-app-unit.ss +++ b/collects/typed-scheme/typecheck/tc-app-unit.ss @@ -376,21 +376,22 @@ [(or (Poly-names: msg-vars (Function: (list (arr: msg-doms msg-rngs msg-rests msg-drests '() _ _) ...))) (PolyDots-names: msg-vars (Function: (list (arr: msg-doms msg-rngs msg-rests msg-drests '() _ _) ...)))) (let ([fcn-string (if name - (format "function ~a (over ~~a)" (syntax->datum name)) - "function over ~a")]) + (format "function ~a" (syntax->datum name)) + "function")]) (if (and (andmap null? msg-doms) (null? argtypes)) (tc-error/expr #:return (ret (Un)) (string-append "Could not infer types for applying polymorphic " fcn-string - "\n") - (stringify msg-vars)) + "\n")) (tc-error/expr #:return (ret (Un)) (string-append "Polymorphic " fcn-string " could not be applied to arguments:~n" - (domain-mismatches t msg-doms msg-rests msg-drests argtypes #f #f)) - (stringify msg-vars))))])) + (domain-mismatches t msg-doms msg-rests msg-drests argtypes #f #f) + (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars))) + (string-append "Type Variables: " (stringify msg-vars) "\n") + "")))))])) (define (tc/funapp f-stx args-stx ftype0 argtys expected) @@ -454,7 +455,7 @@ (Function: (list (arr: doms rngs (and rests #f) (and drests #f) '() thn-effs els-effs) ...)))))) (handle-clauses (doms rngs) f-stx (lambda (dom _) (= (length dom) (length argtypes))) - (lambda (dom rng) (infer (fv/list (cons rng dom)) argtypes dom rng (fv rng) expected)) + (lambda (dom rng) (infer vars argtypes dom rng (fv rng) expected)) t argtypes expected)] ;; polymorphic varargs [(tc-result: (and t