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

Allow apply to work on lists with minimum length.

Browse Source 
original commit: 3e3e79cf1f1fa46f085da41c3f20d7286dc65940
This commit is contained in:
Eric Dobson 2014-04-25 23:07:57 -07:00
parent b0da322f03
commit 34575cbb0f
3 changed files with 23 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -185,11 +185,11 @@
(eq? (cdr drest) dotted-var)
(= (length domain) (length arg-tys))
(match full-tail-ty
[(Listof: tail-arg-ty)
[(List: tail-arg-tys #:tail (Listof: tail-arg-ty))
(infer/vararg
fixed-vars (list dotted-var)
(cons tail-arg-ty arg-tys)
(cons (car drest) domain)
(cons tail-arg-ty (append tail-arg-tys arg-tys))
(cons (car drest) (append (map (λ _ (car drest)) tail-arg-tys) domain))
rest
range)]
[(List: tail-arg-tys)

20
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/match-expanders.rkt
View File

@ -28,16 +28,22 @@
(lambda (stx)
(syntax-parse stx
[(_ elem-pats)
#'(app untuple (? values elem-pats))])))
#'(app untuple (? values elem-pats) (Value: '()))]
[(_ elem-pats #:tail tail-pat)
#'(app untuple (? values elem-pats) tail-pat)])))
;; Type/c -> (or/c (values/c #f #f) (values/c (listof Type/c) Type/c)))
;; Returns the prefix of types that are consed on to the last type (a non finite-pair type).
;; The last type may contain pairs if it is a list type.
(define (untuple t)
(let loop ((t t) (seen (set)))
(and (not (set-member? seen (Type-seq t)))
(match (resolve t)
[(Value: '()) null]
[(Pair: a b) (cond [(loop b (set-add seen (Type-seq t))) => (lambda (l) (cons a l))]
[else #f])]
[_ #f]))))
(if (not (set-member? seen (Type-seq t)))
(match (resolve t)
[(Pair: a b)
(define-values (elems tail) (loop b (set-add seen (Type-seq t))))
(values (cons a elems) tail)]
[_ (values null t)])
(values null t))))
(define-match-expander MListof:
(lambda (stx)

10
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -2851,7 +2851,13 @@
(let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)])
(lambda xs (apply f xs)))
#:ret (ret (->* (list) Univ Univ))
#:expected (ret (->* (list) Univ Univ))]
#:expected (ret (->* (list) Univ Univ))]
[tc-e
(let: ([f : (All (b ...) (Any ... b -> Any)) (lambda x 'x)])
(lambda xs (apply f (ann (cons 'y xs) (cons Symbol (Listof Any))))))
#:ret (ret (->* (list) Univ Univ))
#:expected (ret (->* (list) Univ Univ))]
[tc-e
(let ()
@ -2878,8 +2884,6 @@
-Symbol
#:expected (ret -Symbol)]
)
(test-suite
"tc-literal tests"