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,26 +65,19 @@
(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) (cond
(if (empty? vars) ;; the actual work, when we have a * function
(and (subtype s t) (do-ret range)) [rest (make-Listof rest)]
(finish (infer vars null (list s) (list t) range)))) ;; ... function
[drest (make-ListDots (car drest) (cdr drest))]
(local-infer ;; the function has no rest argument,
(-Tuple* arg-tys full-tail-ty) ;; but provides all the necessary fixed arguments
(-Tuple* domain [else -Null])))
(cond range)))
;; the actual work, when we have a * function
[rest (make-Listof rest)]
;; ... function
[drest (make-ListDots (car drest) (cdr drest))]
;; the function has no rest argument,
;; but provides all the necessary fixed arguments
[else -Null]))))
(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))))