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

Error if we get a type that may be undefined and we don't expect it.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-12-08 19:47:27 -05:00
parent b045153177
commit 53719600d8
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/typed-scheme/typecheck/tc-let-unit.rkt
View File

@ -27,7 +27,7 @@
[(tc-results: ts _ _) [(tc-results: ts _ _)
(ret ts (for/list ([f ts]) (make-NoFilter)) (for/list ([f ts]) (make-NoObject)))])) (ret ts (for/list ([f ts]) (make-NoFilter)) (for/list ([f ts]) (make-NoObject)))]))
(d/c (do-check expr->type namess results form exprs body clauses expected #:abstract [abstract null]) (d/c (do-check expr->type namess results expected-results form exprs body clauses expected #:abstract [abstract null])
(((syntax? syntax? tc-results? . c:-> . any/c) (((syntax? syntax? tc-results? . c:-> . any/c)
(listof (listof identifier?)) (listof tc-results?) (listof (listof identifier?)) (listof tc-results?)
syntax? (listof syntax?) syntax? (listof syntax?) (or/c #f tc-results?)) syntax? (listof syntax?) syntax? (listof syntax?) (or/c #f tc-results?))
@ -66,7 +66,7 @@
(for-each expr->type (for-each expr->type
clauses clauses
exprs exprs
results) expected-results)
(let ([subber (lambda (proc lst) (let ([subber (lambda (proc lst)
(for/list ([i (in-list lst)]) (for/list ([i (in-list lst)])
(for/fold ([s i]) (for/fold ([s i])
@ -117,7 +117,7 @@
;; after everything, check the body expressions ;; after everything, check the body expressions
[(null? names) [(null? names)
;(if expected (tc-exprs/check (syntax->list body) expected) (tc-exprs (syntax->list body))) ;(if expected (tc-exprs/check (syntax->list body) expected) (tc-exprs (syntax->list body)))
(do-check void null null form null body null expected #:abstract orig-flat-names)] (do-check void null null null form null body null expected #:abstract orig-flat-names)]
;; if none of the names bound in the letrec are free vars of this rhs ;; if none of the names bound in the letrec are free vars of this rhs
[(not (ormap (lambda (n) (s:member n flat-names bound-identifier=?)) [(not (ormap (lambda (n) (s:member n flat-names bound-identifier=?))
(free-vars (car exprs)))) (free-vars (car exprs))))
@ -156,6 +156,8 @@
(map (λ (x) (make-Union (list x -Undefined))) (map (λ (x) (make-Union (list x -Undefined)))
types-from-user))))) types-from-user)))))
names)) names))
;; types the user gave. check against that to error if we could get undefined
(map (λ (l) (ret (map get-type l))) names)
form exprs body clauses expected)])))) form exprs body clauses expected)]))))
;; determines whether any of the variables bound in the given clause can have an undefined value ;; determines whether any of the variables bound in the given clause can have an undefined value
@ -219,6 +221,4 @@
tc-expr/check))] tc-expr/check))]
;; the clauses for error reporting ;; the clauses for error reporting
[clauses (syntax-case form () [(lv cl . b) (syntax->list #'cl)])]) [clauses (syntax-case form () [(lv cl . b) (syntax->list #'cl)])])
(do-check void names types form exprs body clauses expected))) (do-check void names types types form exprs body clauses expected)))