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

Fix inference when filters/objects are not needed

Browse Source 
svn: r14790
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-12 21:31:21 +00:00
parent a8a64cfa7c
commit 8fc6e38b11
2 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/typed-scheme/infer/infer-unit.ss
View File

@ -393,6 +393,10 @@
[((Result: s f o)
(Result: t f o))
(cg s t)]
;; handle the trivial case where we need to filters/etc
[((Result: s f o)
(Result: t (LFilterSet: '() '()) (LEmpty:)))
(cg s t)]
[(_ _)
(cond [(subtype S T) empty]
;; or, nothing worked, and we fail
@ -452,6 +456,7 @@
(define (infer X S T R must-vars [expected #f])
(with-handlers ([exn:infer? (lambda _ #f)])
(let ([cs (cgen/list null X S T)])
;(printf "cs: ~a~n" cs)
(if (not expected)
(subst-gen cs R must-vars)
(subst-gen (cset-meet cs (cgen null X R expected)) R must-vars)))))
@ -486,4 +491,4 @@
(define (i s t r)
(infer/simple (list s) (list t) r))
;(trace cgen subst-gen)
;(trace cgen/list)

4
collects/typed-scheme/typecheck/tc-app.ss
View File

@ -259,7 +259,7 @@
(fv (car rngs*))))
=> (lambda (substitution) (do-ret (subst-all substitution (car rngs*))))]
;; ... function, ... arg
[(and (car drests*)
[(and (car drests*)
tail-bound
(eq? tail-bound (cdr (car drests*)))
(= (length (car doms*))
@ -316,7 +316,7 @@
tail-bound
(eq? tail-bound (cdr (car drests*)))
(= (length (car doms*))
(length arg-tys))
(length arg-tys))
(infer vars (cons tail-ty arg-tys) (cons (car (car drests*)) (car doms*)) (car rngs*) (fv (car rngs*))))
=> (lambda (substitution)
(do-ret (subst-all substitution (car rngs*))))]