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

Just handle PolyDots of stuff not involving dots like the other cases.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2008-06-18 17:36:38 -04:00
parent 7f0a330c0c
commit 082545adc9
1 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/typed-scheme/private/tc-app-unit.ss
View File

@ -390,7 +390,8 @@
argtypes)]
[(subtypes/varargs argtypes (car doms*) (car rests*)) (ret (car rngs))]
[else (loop (cdr doms*) (cdr rngs) (cdr rests*))])))]
[(and rft (tc-result: (Poly: vars (Function: (list (arr: doms rngs #f #f thn-effs els-effs) ...)))))
[(and rft (tc-result: (or (Poly: vars (Function: (list (arr: doms rngs #f #f thn-effs els-effs) ...)))
(PolyDots: (list vars ... _) (Function: (list (arr: doms rngs #f #f thn-effs els-effs) ...))))))
;(printf "Typechecking poly app~nftype: ~a~n" ftype)
;(printf "ftype again: ~a~n" ftype)
;(printf "resolved ftype: ~a : ~a~n" (equal? rft ftype) rft)
@ -435,7 +436,8 @@
)]|#
[else (loop (cdr doms*) (cdr rngs*))]))]
;; polymorphic varargs
[(tc-result: (Poly: vars (Function: (list (arr: dom rng rest #f thn-eff els-eff)))))
[(tc-result: (or (Poly: vars (Function: (list (arr: dom rng rest #f thn-eff els-eff))))
(PolyDots: (list vars ... _) (Function: (list (arr: dom rng rest #f thn-eff els-eff))))))
(for-each (lambda (x) (unless (not (Poly? x))
(tc-error "Polymorphic argument ~a to polymorphic function not allowed" x)))
argtypes)