Try harder to find types for loop variables.
- use `find-annotation' more - recognize (let ([x y]) ...)
This commit is contained in:
parent
8a0bab9fe3
commit
bdbb6d48e6
3
collects/tests/typed-scheme/succeed/for-in-range.rkt
Normal file
3
collects/tests/typed-scheme/succeed/for-in-range.rkt
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
#lang typed/racket
|
||||||
|
|
||||||
|
(for: ([i : Integer (in-range 10 0 -1)]) i)
|
|
@ -45,13 +45,19 @@
|
||||||
|
|
||||||
;; expr id -> type or #f
|
;; expr id -> type or #f
|
||||||
;; if there is a binding in stx of the form:
|
;; if there is a binding in stx of the form:
|
||||||
;; (let ([x (reverse name)]) e)
|
;; (let ([x (reverse name)]) e) or
|
||||||
|
;; (let ([x name]) e)
|
||||||
;; where x has a type annotation, return that annotation, otherwise #f
|
;; where x has a type annotation, return that annotation, otherwise #f
|
||||||
(define (find-annotation stx name)
|
(define (find-annotation stx name)
|
||||||
(define (find s) (find-annotation s name))
|
(define (find s) (find-annotation s name))
|
||||||
(define (match? b)
|
(define (match? b)
|
||||||
(syntax-parse b
|
(syntax-parse b
|
||||||
#:literals (#%plain-app reverse)
|
#:literals (#%plain-app reverse)
|
||||||
|
[c:lv-clause
|
||||||
|
#:with n:id #'c.e
|
||||||
|
#:with (v) #'(c.v ...)
|
||||||
|
#:fail-unless (free-identifier=? name #'n) #f
|
||||||
|
(or (type-annotation #'v) (lookup-type/lexical #'v #:fail (lambda _ #f)))]
|
||||||
[c:lv-clause
|
[c:lv-clause
|
||||||
#:with (#%plain-app reverse n:id) #'c.e
|
#:with (#%plain-app reverse n:id) #'c.e
|
||||||
#:with (v) #'(c.v ...)
|
#:with (v) #'(c.v ...)
|
||||||
|
|
|
@ -235,12 +235,14 @@
|
||||||
(tc/rec-lambda/check form args body lp (cons acc-ty ts) expected)
|
(tc/rec-lambda/check form args body lp (cons acc-ty ts) expected)
|
||||||
expected)]
|
expected)]
|
||||||
;; special case when argument needs inference
|
;; special case when argument needs inference
|
||||||
[_
|
[(_ (body*) _)
|
||||||
(let ([ts (for/list ([ac (syntax->list actuals)]
|
(let ([ts (for/list ([ac (syntax->list actuals)]
|
||||||
[f (syntax->list args)])
|
[f (syntax->list args)])
|
||||||
(let ([infer-t (type-annotation f #:infer #t)])
|
(let* ([infer-t (or (type-annotation f #:infer #t)
|
||||||
|
(find-annotation #'body* f))])
|
||||||
(if infer-t
|
(if infer-t
|
||||||
(check-below (tc-expr/t ac) infer-t)
|
(begin (check-below (tc-expr/t ac) infer-t)
|
||||||
|
infer-t)
|
||||||
(generalize (tc-expr/t ac)))))])
|
(generalize (tc-expr/t ac)))))])
|
||||||
(tc/rec-lambda/check form args body lp ts expected)
|
(tc/rec-lambda/check form args body lp ts expected)
|
||||||
expected)]))
|
expected)]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user