Simplify different cases in poly tc-apply.

This commit is contained in:
Eric Dobson 2014-04-28 21:20:21 -07:00
parent 976c1de96d
commit afb3d99dc3

View File

@ -82,30 +82,21 @@
[range (in-list rngs)] [range (in-list rngs)]
[rest (in-list rests)] [rest (in-list rests)]
[drest (in-list drests)]) [drest (in-list drests)])
(define (finish substitution) (do-ret (subst-all substitution range))) (define (finish substitution)
(cond (and substitution (do-ret (subst-all substitution range))))
;; the actual work, when we have a * function (finish
[(and rest (infer vars null
(infer vars null (list (-Tuple* arg-tys full-tail-ty))
(list (-Tuple* arg-tys full-tail-ty)) (list (-Tuple* domain
(list (-Tuple* domain (make-Listof rest))) (cond
range)) ;; the actual work, when we have a * function
=> finish] [rest (make-Listof rest)]
;; the function has no rest argument, but provides all the necessary fixed arguments ;; ... function
[(and (not rest) (not drest) [drest (make-ListDots (car drest) (cdr drest))]
(infer vars null ;; the function has no rest argument,
(list (-Tuple* arg-tys full-tail-ty)) ;; but provides all the necessary fixed arguments
(list (-Tuple domain)) [else (-val '())])))
range)) range)))
=> finish]
;; ... function
[(and drest
(infer vars null
(list (-Tuple* arg-tys full-tail-ty))
(list (-Tuple* domain (make-ListDots (car drest) (cdr drest))))
range))
=> finish]
[else #f]))
(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))))