Remove special case of subtype in tc-apply.

This commit is contained in:
Eric Dobson 2014-05-09 21:20:44 -07:00
parent 7e45bc7166
commit 7d88b7a6cb

View File

@ -65,18 +65,10 @@
(define (finish substitution) (define (finish substitution)
(and substitution (do-ret (subst-all substitution range)))) (and substitution (do-ret (subst-all substitution range))))
;; Figures out if there is a possible substitution of vars and if there is uses that (finish
;; substitution to compute the actual range type. (infer vars null
;; Currently if vars is null, then we use subtype instead because inference is missing some (list (-Tuple* arg-tys full-tail-ty))
;; cases that are covered by subtype. (list (-Tuple* domain
(define (local-infer s t)
(if (empty? vars)
(and (subtype s t) (do-ret range))
(finish (infer vars null (list s) (list t) range))))
(local-infer
(-Tuple* arg-tys full-tail-ty)
(-Tuple* domain
(cond (cond
;; the actual work, when we have a * function ;; the actual work, when we have a * function
[rest (make-Listof rest)] [rest (make-Listof rest)]
@ -84,7 +76,8 @@
[drest (make-ListDots (car drest) (cdr drest))] [drest (make-ListDots (car drest) (cdr drest))]
;; the function has no rest argument, ;; the function has no rest argument,
;; but provides all the necessary fixed arguments ;; but provides all the necessary fixed arguments
[else -Null])))) [else -Null])))
range)))
(failure))] (failure))]
[(tc-result1: (PolyDots: (and vars (list fixed-vars ... dotted-var)) [(tc-result1: (PolyDots: (and vars (list fixed-vars ... dotted-var))
(Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))) (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))