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

Untyped top-level variables are not an internal error.

Browse Source 
Handle latent filter of LBot in values->tc-results when there are no formals.
Use check-below properly in tc/mono-lambda/type

svn: r14935
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-22 20:07:36 +00:00
parent 23a735ee2f
commit 2ee1d2b596
3 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/typed-scheme/typecheck/tc-lambda-unit.ss
View File

@ -209,7 +209,7 @@
(define (tc/mono-lambda/type formals bodies expected) (define (tc/mono-lambda/type formals bodies expected)
(define t (make-Function (map lam-result->type (tc/mono-lambda formals bodies expected)))) (define t (make-Function (map lam-result->type (tc/mono-lambda formals bodies expected))))
(if expected (if expected
(check-below t expected) (and (check-below (ret t true-filter) expected) t)
t)) t))
;; tc/plambda syntax syntax-list syntax-list type -> Poly ;; tc/plambda syntax syntax-list syntax-list type -> Poly

16
collects/typed-scheme/typecheck/tc-metafunctions.ss
View File

@ -149,9 +149,15 @@
[(ValuesDots: (list (Result: ts lfs los) ...) dty dbound) [(ValuesDots: (list (Result: ts lfs los) ...) dty dbound)
(ret ts (ret ts
(for/list ([lf lfs]) (for/list ([lf lfs])
(or
(and (null? formals)
(match lf
[(LFilterSet: lf+ lf-)
(combine (if (memq (make-LBot) lf+) (list (make-Bot)) (list))
(if (memq (make-LBot) lf-) (list (make-Bot)) (list)))]))
(merge-filter-sets (merge-filter-sets
(for/list ([x formals] [i (in-naturals)]) (for/list ([x formals] [i (in-naturals)])
(apply-filter (split-lfilters lf i) Univ (make-Path null x))))) (apply-filter (split-lfilters lf i) Univ (make-Path null x))))))
(for/list ([lo los]) (for/list ([lo los])
(or (or
(for/or ([x formals] [i (in-naturals)]) (for/or ([x formals] [i (in-naturals)])
@ -163,9 +169,15 @@
[(Values: (list (Result: ts lfs los) ...)) [(Values: (list (Result: ts lfs los) ...))
(ret ts (ret ts
(for/list ([lf lfs]) (for/list ([lf lfs])
(or
(and (null? formals)
(match lf
[(LFilterSet: lf+ lf-)
(combine (if (memq (make-LBot) lf+) (list (make-Bot)) (list))
(if (memq (make-LBot) lf-) (list (make-Bot)) (list)))]))
(merge-filter-sets (merge-filter-sets
(for/list ([x formals] [i (in-naturals)]) (for/list ([x formals] [i (in-naturals)])
(apply-filter (split-lfilters lf i) Univ (make-Path null x))))) (apply-filter (split-lfilters lf i) Univ (make-Path null x))))))
(for/list ([lo los]) (for/list ([lo los])
(or (or
(for/or ([x formals] [i (in-naturals)]) (for/or ([x formals] [i (in-naturals)])

2
collects/typed-scheme/types/utils.ss
View File

@ -290,7 +290,7 @@
(define (lookup-fail e) (define (lookup-fail e)
(match (identifier-binding e) (match (identifier-binding e)
['lexical (int-err "untyped lexical variable ~a" (syntax-e e))] ['lexical (int-err "untyped lexical variable ~a" (syntax-e e))]
[#f (int-err "untyped top-level variable ~a" (syntax-e e))] [#f (tc-error/expr "untyped top-level identifier ~a" (syntax-e e))]
[(list _ _ nominal-source-mod nominal-source-id _ _ _) [(list _ _ nominal-source-mod nominal-source-id _ _ _)
(let-values ([(x y) (module-path-index-split nominal-source-mod)]) (let-values ([(x y) (module-path-index-split nominal-source-mod)])
(cond [(and (not x) (not y)) (cond [(and (not x) (not y))