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

Change type of ... rest args to have (List T ...) types.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-27 17:02:47 -04:00
parent 71939d2826
commit 4cbeb0b2f0
2 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/typed-scheme/succeed/list-dots.rkt
View File

@ -3,4 +3,7 @@
(: f (All (a ...) ((List a ...) -> (List a ... a)))) (: f (All (a ...) ((List a ...) -> (List a ... a))))
(define (f x) x) (define (f x) x)
(ann (values (inst f String Number Boolean)) String) (: g (All (a ...) (a ... -> (List a ...))))
(define (g . x) x)
(g 7 7 7)

19
collects/typed-scheme/typecheck/tc-lambda-unit.rkt
View File

@ -13,7 +13,7 @@
[make-arr* make-arr]) [make-arr* make-arr])
(private type-annotation) (private type-annotation)
(types abbrev utils) (types abbrev utils)
(env type-env-structs lexical-env dotted-env tvar-env) (env type-env-structs lexical-env tvar-env)
(utils tc-utils) (utils tc-utils)
unstable/debug unstable/debug
scheme/match) scheme/match)
@ -87,15 +87,15 @@
[(not rest) [(not rest)
(check-body)] (check-body)]
[drest [drest
(with-dotted-env/extend (with-lexical-env/extend
rest (car drest) (cdr drest) (list rest) (list (make-ListDots (car drest) (cdr drest)))
(check-body))] (check-body))]
[(dotted? rest) [(dotted? rest)
=> =>
(lambda (b) (lambda (b)
(let ([dty (get-type rest #:default Univ)]) (let ([dty (get-type rest #:default Univ)])
(with-dotted-env/extend (with-lexical-env/extend
rest dty b (list rest) (list (make-ListDots dty b))
(check-body))))] (check-body))))]
[else [else
(let ([rest-type (cond (let ([rest-type (cond
@ -148,17 +148,14 @@
(current-tvars))]) (current-tvars))])
(get-type #'rest #:default Univ))]) (get-type #'rest #:default Univ))])
(with-lexical-env/extend (with-lexical-env/extend
arg-list (cons #'rest arg-list)
arg-types (cons (make-ListDots rest-type bound) arg-types)
(parameterize ([dotted-env (extend-env (list #'rest)
(list (cons rest-type bound))
(dotted-env))])
(make-lam-result (make-lam-result
(map list arg-list arg-types) (map list arg-list arg-types)
null null
#f #f
(cons #'rest (cons rest-type bound)) (cons #'rest (cons rest-type bound))
(tc-exprs (syntax->list body)))))))] (tc-exprs (syntax->list body))))))]
[else [else
(let ([rest-type (get-type #'rest #:default Univ)]) (let ([rest-type (get-type #'rest #:default Univ)])
(with-lexical-env/extend (with-lexical-env/extend