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

Simplify different cases in poly tc-apply.

Browse Source 
original commit: afb3d99dc32942be34ffafdc3c114671dcc448cc
This commit is contained in:
Eric Dobson 2014-04-28 21:20:21 -07:00
parent 736a97e0b4
commit be1e28cb5d
1 changed files with 15 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
View File

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